1 | include(dom.inc)
2 |
3 | SUBROUTINE SNB_CASE(all_k_abs, w, Lb, celldata, ielmts, all_WVNB, &
4 | & all_DWVNB, KCO, DCO, KC, DC, KH, DH, ngbands, &
5 | & i_bande, nallbandes, nkabs, ieltd, ieltf)
6 |
7 | USE mod_inout
8 | USE mod_pmm
9 | #ifdef USEPALM
10 | USE palmlib
11 | #endif
12 |
13 | IMPLICIT NONE
14 |
15 | ! IN
16 | DOM_INT :: nallbandes
17 | DOM_INT :: nkabs, ieltd, ieltf
18 | DOM_INT :: ielmts,ngbands
19 | DOM_REAL,DIMENSION(14,nallbandes):: KCO,DCO,KC,DC,KH,DH
20 | DOM_REAL,DIMENSION(nallbandes) :: all_WVNB,all_DWVNB
21 | DOM_REAL,DIMENSION(ielmts) :: Lb
22 | DOM_REAL,DIMENSION(8,ielmts) :: celldata
23 |
24 | ! OUT
25 | DOM_REAL,DIMENSION(nkabs) :: w
26 | DOM_REAL,DIMENSION(nkabs,ielmts) :: all_k_abs
27 |
28 | ! LOCAL
29 | DOM_REAL,DIMENSION(nkabs,ielmts) :: local_all_k_abs
30 | DOM_REAL,DIMENSION(2,ngbands) :: SNBDATA
31 | DOM_REAL,DIMENSION(ielmts) :: WVSOOT
32 | DOM_REAL,DIMENSION(nkabs) :: k_absmel
33 | DOM_REAL,DIMENSION(ngbands) :: F
34 | DOM_REAL :: blae
35 | DOM_REAL :: WVNB,DWVNB,WVNB_SI,DWVNB_SI
36 | DOM_INT :: ielt, i, ierr
37 | DOM_INT :: i_bande
38 | DOM_INT :: ICO,ICO2,IH2O
39 | LOGICAL :: LICO,LICO2,LIH2O
40 |
41 | WVNB = all_WVNB(i_bande)
42 | DWVNB = all_DWVNB(i_bande)
43 | WVNB_SI = 100.*WVNB
44 | DWVNB_SI = 100.*DWVNB
45 | WVSOOT = WVNB_SI*5.5*celldata(8,:)
46 |
47 | local_all_k_abs = 0.
48 | all_k_abs = 0.
49 | k_absmel = 0.
50 |
51 | ! ----------------------------------------!
52 | ! Spectral index lecture for each species !
53 | ! ----------------------------------------!
54 |
55 | IF (WVNB.le.9300.0) THEN
56 | CALL FINDI(LICO,LICO2,LIH2O,ICO,ICO2,IH2O,WVNB,DWVNB)
57 | ENDIF
58 |
59 | ! -----------------------!
60 | ! Non-homogeneous system !
61 | ! -----------------------!
62 | IF (homosyst.eq.'NO') THEN
63 |
64 | DO ielt = ieltd, ieltf
65 |
66 | ! print*, pmm_rank, "Doing cell:",ielt,"/",ieltd,"->",ieltf
67 |
68 | IF (WVNB<=9300.0) THEN
69 |
70 | CALL KBARANDPHI(celldata(:,ielt),LICO,LICO2,LIH2O,ICO,ICO2, &
71 | & IH2O,KCO,KC,KH,DCO,DC,DH,SNBDATA,nallbandes)
72 |
73 | ! print*, pmm_rank, " phi_mix, k_mix=", SNBDATA(2,1), &
74 | ! & SNBDATA(1,1)
75 |
76 | ! -----------------------------------------------------!
77 | ! Band groupment multiplicative factor (=1 for SNB-ck) !
78 | ! -----------------------------------------------------!
79 | DO i = 1, ngbands
80 | F(i) = 1.
81 | ENDDO
82 |
83 | CALL k_distributeur(F, ngbands, SNBDATA, nkabs, k_absmel, w)
84 |
85 | ENDIF
86 |
87 | local_all_k_abs(:,ielt)=k_absmel(:)+WVSOOT(ielt)
88 |
89 | ENDDO
90 |
91 | ! -------------------!
92 | ! Homogeneous system !
93 | ! -------------------!
94 |
95 | ELSEIF (homosyst.eq.'YES') THEN
96 |
97 | IF (WVNB<=9300.0) THEN
98 | CALL KBARANDPHI(celldata(:,1),LICO,LICO2,LIH2O,ICO,ICO2,IH2O, &
99 | & KCO,KC,KH,DCO,DC,DH,SNBDATA,nallbandes)
100 |
101 | ! -----------------------------------------------------!
102 | ! Band groupment multiplicative factor (=1 for SNB-ck) !
103 | ! -----------------------------------------------------!
104 | DO i = 1, ngbands
105 | F(i) = 1.
106 | ENDDO
107 |
108 | CALL k_distributeur(F, ngbands, SNBDATA, nkabs, k_absmel, w)
109 |
110 | ENDIF
111 |
112 | DO ielt = ieltd, ieltf
113 | local_all_k_abs(:,ielt) = k_absmel(:) + WVSOOT(1)
114 | ENDDO
115 |
116 | ENDIF
117 |
118 | ! ------------------------------------------------!
119 | ! sending all_k_abs....change to a pmm subroutine !
120 | ! ------------------------------------------------!
121 |
122 | #ifdef USEPALM
123 | CALL MPI_ALLREDUCE(local_all_k_abs, all_k_abs, nkabs*ielmts, &
124 | & MPI_DOUBLE_PRECISION, MPI_SUM, PL_COMM_EXEC ,&
125 | & ierr)
126 | #else
127 | CALL MPI_ALLREDUCE(local_all_k_abs, all_k_abs, nkabs*ielmts, &
128 | & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD,&
129 | & ierr)
130 | #endif
131 |
132 | ! if (pmm_rank.eq.0) then
133 | ! do i = 1, ielmts
134 | ! print*, "kabs:",all_k_abs(:,i)
135 | ! enddo
136 | ! endif
137 |
138 | END SUBROUTINE SNB_CASE
139 |