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