1 | include(dom.inc)
2 |
3 | SUBROUTINE EMISSIV(celldata, Lb, Lo, epsil, Tf, nelmts, &
4 | & ieltd, ieltf, bcell, bface, nbface, &
5 | & bfbeg, bfend)
6 |
7 | USE mod_pmm
8 | #ifdef USEPALM
9 | USE palmlib
10 | #endif
11 |
12 | IMPLICIT NONE
13 |
14 | include 'dom_constants.h'
15 |
16 | ! IN
17 | DOM_INT :: nelmts,nbface
18 | DOM_INT :: ieltd, ieltf
19 | DOM_INT :: bfbeg, bfend
20 | DOM_REAL, DIMENSION(8,nelmts) :: celldata
21 | DOM_REAL, DIMENSION(nbface) :: epsil, Tf
22 | DOM_INT , DIMENSION(nbface) :: bcell, bface
23 |
24 | ! OUT
25 | DOM_REAL, DIMENSION(nelmts) :: Lb
26 | DOM_REAL, DIMENSION(nbface) :: Lo
27 |
28 | ! LOCAL
29 | DOM_INT :: ielt,m, ibnd
30 | DOM_INT :: local_ncell
31 | DOM_INT :: ierr
32 | DOM_REAL :: planck
33 | DOM_REAL, DIMENSION(nelmts) :: local_Lb
34 | DOM_REAL, DIMENSION(nbface) :: local_Lo
35 |
36 | Lo = 0.
37 | Lb = 0.
38 |
39 | ! -----------------------------!
40 | ! Initializing local cell data !
41 | ! -----------------------------!
42 |
43 | local_Lo = 0.
44 | local_Lb = 0.
45 |
46 | ! --------------------------------------------------------!
47 | ! Intensities at the boundaries in the partitioned domain !
48 | ! --------------------------------------------------------!
49 |
50 | DO ibnd = bfbeg, bfend
51 |
52 | local_Lo(ibnd)=epsil(ibnd)*planck(Tf(ibnd))
53 |
54 | ENDDO
55 |
56 | ! ---------------------------------------------!
57 | ! Spectral intensity in the partitioned domain !
58 | ! ---------------------------------------------!
59 |
60 | DO ielt = ieltd, ieltf
61 |
62 | local_Lb(ielt)=planck(celldata(1,ielt))
63 |
64 | ENDDO
65 |
66 | ! ---------------------------------------!
67 | ! communcation....to put in pmm_reducelb !
68 | ! ---------------------------------------!
69 |
70 | ! print*, " proc ", pmm_rank,": sending L (",ieltd,",",ieltf,")"
71 | #ifdef USEPALM
72 | CALL MPI_ALLREDUCE(local_Lo, Lo, nbface, &
73 | & MPI_DOUBLE_PRECISION, MPI_SUM, PL_COMM_EXEC ,&
74 | & ierr)
75 |
76 | CALL MPI_ALLREDUCE(local_Lb, Lb, nelmts, MPI_DOUBLE_PRECISION, &
77 | & MPI_SUM, PL_COMM_EXEC , ierr)
78 | #else
79 | CALL MPI_ALLREDUCE(local_Lo, Lo, nbface, &
80 | & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD,&
81 | & ierr)
82 |
83 | CALL MPI_ALLREDUCE(local_Lb, Lb, nelmts, MPI_DOUBLE_PRECISION, &
84 | & MPI_SUM, MPI_COMM_WORLD, ierr)
85 | #endif
86 |
87 | END SUBROUTINE EMISSIV
emissiv.F could be called by: