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