[38] | 1 | SUBROUTINE concentrations(pplay,pt,pdt,pq,pdq,ptimestep) |
---|
| 2 | |
---|
[370] | 3 | implicit none |
---|
| 4 | |
---|
[38] | 5 | c======================================================================= |
---|
| 6 | c CALCULATION OF MEAN MOLECULAR MASS, Cp, Akk and R |
---|
| 7 | c |
---|
[370] | 8 | c mmean(ngridmx,nlayermx) amu |
---|
| 9 | c cpnew(ngridmx,nlayermx) J/kg/K |
---|
| 10 | c rnew(ngridmx,nlayermx) J/kg/K |
---|
| 11 | c akknew(ngridmx,nlayermx) coefficient of thermal concduction |
---|
[38] | 12 | c |
---|
[370] | 13 | c version: March 2011 - Franck Lefevre |
---|
[38] | 14 | c======================================================================= |
---|
[370] | 15 | |
---|
| 16 | c Declarations |
---|
| 17 | c ------------ |
---|
| 18 | |
---|
[38] | 19 | #include "dimensions.h" |
---|
| 20 | #include "dimphys.h" |
---|
| 21 | #include "comcstfi.h" |
---|
| 22 | #include "callkeys.h" |
---|
| 23 | #include "comdiurn.h" |
---|
| 24 | #include "chimiedata.h" |
---|
| 25 | #include "tracer.h" |
---|
| 26 | #include "conc.h" |
---|
| 27 | |
---|
| 28 | c Input/Output |
---|
| 29 | c ------------ |
---|
| 30 | |
---|
[370] | 31 | real pplay(ngridmx,nlayermx) |
---|
| 32 | real pt(ngridmx,nlayermx) |
---|
| 33 | real pdt(ngridmx,nlayermx) |
---|
[38] | 34 | real pq(ngridmx,nlayermx,nqmx) |
---|
[370] | 35 | real pdq(ngridmx,nlayermx,nqmx) |
---|
| 36 | real ptimestep |
---|
[38] | 37 | |
---|
[370] | 38 | c Local variables |
---|
| 39 | c --------------- |
---|
[38] | 40 | |
---|
[370] | 41 | integer :: l, ig, n, k |
---|
| 42 | integer, save :: gind(ncomp) |
---|
| 43 | real :: ni(nqmx), ntot |
---|
| 44 | real :: zq(ngridmx,nlayermx,ncomp) |
---|
| 45 | real :: zt(ngridmx,nlayermx) |
---|
| 46 | real, save :: aki(ncomp) |
---|
| 47 | real, save :: cpi(ncomp) |
---|
| 48 | |
---|
| 49 | logical, save :: firstcall = .true. |
---|
| 50 | |
---|
[38] | 51 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 52 | c tracer numbering for the thermal conduction and |
---|
| 53 | c specific heat coefficients |
---|
| 54 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
[370] | 55 | |
---|
[38] | 56 | integer,parameter :: i_co2 = 1 |
---|
| 57 | integer,parameter :: i_co = 2 |
---|
| 58 | integer,parameter :: i_o = 3 |
---|
| 59 | integer,parameter :: i_o1d = 4 |
---|
| 60 | integer,parameter :: i_o2 = 5 |
---|
| 61 | integer,parameter :: i_o3 = 6 |
---|
| 62 | integer,parameter :: i_h = 7 |
---|
| 63 | integer,parameter :: i_h2 = 8 |
---|
| 64 | integer,parameter :: i_oh = 9 |
---|
| 65 | integer,parameter :: i_ho2 = 10 |
---|
| 66 | integer,parameter :: i_h2o2 = 11 |
---|
[370] | 67 | integer,parameter :: i_ch4 = 12 |
---|
| 68 | integer,parameter :: i_n2 = 13 |
---|
| 69 | integer,parameter :: i_ar = 14 |
---|
| 70 | integer,parameter :: i_h2o = 15 |
---|
[38] | 71 | |
---|
| 72 | if (firstcall) then |
---|
| 73 | |
---|
| 74 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
[370] | 75 | c initializations at first call: |
---|
| 76 | c fill local array of tracer indexes |
---|
[38] | 77 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 78 | |
---|
[370] | 79 | gind(i_co2) = igcm_co2 ! co2 |
---|
| 80 | gind(i_co) = igcm_co ! co |
---|
| 81 | gind(i_o) = igcm_o ! o |
---|
| 82 | gind(i_o1d) = igcm_o1d ! o1d |
---|
| 83 | gind(i_o2) = igcm_o2 ! o2 |
---|
| 84 | gind(i_o3) = igcm_o3 ! o3 |
---|
| 85 | gind(i_h) = igcm_h ! h |
---|
| 86 | gind(i_h2) = igcm_h2 ! h2 |
---|
| 87 | gind(i_oh) = igcm_oh ! oh |
---|
| 88 | gind(i_ho2) = igcm_ho2 ! ho2 |
---|
| 89 | gind(i_h2o2) = igcm_h2o2 ! h2o2 |
---|
| 90 | gind(i_ch4) = igcm_ch4 ! ch4 |
---|
| 91 | gind(i_n2) = igcm_n2 ! n2 |
---|
| 92 | gind(i_ar) = igcm_ar ! ar |
---|
| 93 | gind(i_h2o) = igcm_h2o_vap ! h2o |
---|
| 94 | |
---|
[38] | 95 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
[370] | 96 | c Thermal conductivity and specific heat coefficients |
---|
[38] | 97 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 98 | |
---|
[370] | 99 | aki(i_co2) = 3.072e-4 |
---|
| 100 | aki(i_co) = 4.87e-4 |
---|
| 101 | aki(i_o) = 7.59e-4 |
---|
| 102 | aki(i_o1d) = 7.59e-4 !? |
---|
| 103 | aki(i_o2) = 5.68e-4 |
---|
| 104 | aki(i_o3) = 3.00e-4 !? |
---|
| 105 | aki(i_h) = 0.0 |
---|
| 106 | aki(i_h2) = 36.314e-4 |
---|
| 107 | aki(i_oh) = 7.00e-4 !? |
---|
| 108 | aki(i_ho2) = 0.0 |
---|
| 109 | aki(i_h2o2) = 0.0 |
---|
| 110 | aki(i_ch4) = 0.0 !? |
---|
| 111 | aki(i_n2) = 5.6e-4 |
---|
| 112 | aki(i_ar) = 0.0 !? |
---|
| 113 | aki(i_h2o) = 0.0 |
---|
[38] | 114 | |
---|
[370] | 115 | cpi(i_co2) = 0.834e3 |
---|
| 116 | cpi(i_co) = 1.034e3 |
---|
| 117 | cpi(i_o) = 1.3e3 |
---|
| 118 | cpi(i_o1d) = 1.3e3 !? |
---|
| 119 | cpi(i_o2) = 0.9194e3 |
---|
| 120 | cpi(i_o3) = 0.800e3 !? |
---|
| 121 | cpi(i_h) = 20.780e3 |
---|
| 122 | cpi(i_h2) = 14.266e3 |
---|
| 123 | cpi(i_oh) = 1.045e3 |
---|
| 124 | cpi(i_ho2) = 1.065e3 !? |
---|
| 125 | cpi(i_h2o2) = 1.000e3 !? |
---|
| 126 | cpi(i_ch4) = 1.000e3 !? |
---|
| 127 | cpi(i_n2) = 1.034e3 |
---|
| 128 | cpi(i_ar) = 1.000e3 !? |
---|
| 129 | cpi(i_h2o) = 1.870e3 |
---|
[38] | 130 | |
---|
[370] | 131 | firstcall=.false. |
---|
[38] | 132 | |
---|
[370] | 133 | end if ! of if (firstcall) |
---|
| 134 | c |
---|
| 135 | c initializations |
---|
| 136 | c |
---|
| 137 | mmean(:,:) = 0. |
---|
| 138 | cpnew(:,:) = 0. |
---|
| 139 | akknew(:,:) = 0. |
---|
| 140 | c |
---|
| 141 | c update temperature |
---|
| 142 | c |
---|
| 143 | do l = 1,nlayermx |
---|
| 144 | do ig = 1,ngridmx |
---|
| 145 | zt(ig,l) = pt(ig,l) + pdt(ig,l)*ptimestep |
---|
| 146 | end do |
---|
| 147 | end do |
---|
| 148 | c |
---|
| 149 | c update tracers |
---|
| 150 | c |
---|
| 151 | do l = 1,nlayermx |
---|
| 152 | do ig = 1,ngridmx |
---|
| 153 | do n = 1,ncomp |
---|
| 154 | zq(ig,l,n) = max(1.e-30, pq(ig,l,gind(n)) |
---|
| 155 | $ + pdq(ig,l,gind(n))*ptimestep) |
---|
| 156 | end do |
---|
| 157 | end do |
---|
| 158 | end do |
---|
| 159 | c |
---|
| 160 | c mmean : mean molecular mass |
---|
| 161 | c rnew : specific gas constant |
---|
| 162 | c |
---|
| 163 | do l = 1,nlayermx |
---|
| 164 | do ig = 1,ngridmx |
---|
| 165 | do n = 1, ncomp |
---|
| 166 | mmean(ig,l) = mmean(ig,l) + zq(ig,l,n)/mmol(gind(n)) |
---|
| 167 | end do |
---|
| 168 | mmean(ig,l) = 1./mmean(ig,l) |
---|
| 169 | rnew(ig,l) = 8.314/mmean(ig,l)*1.e3 ! J/kg/K |
---|
| 170 | end do |
---|
| 171 | end do |
---|
| 172 | c |
---|
| 173 | c cpnew : specicic heat |
---|
| 174 | c akknew : thermal conductivity cofficient |
---|
| 175 | c |
---|
| 176 | do l = 1,nlayermx |
---|
| 177 | do ig = 1,ngridmx |
---|
| 178 | ntot = pplay(ig,l)/(1.381e-23*zt(ig,l))*1.e-6 ! in #/cm3 |
---|
| 179 | do n = 1,ncomp |
---|
| 180 | ni(n) = ntot*zq(ig,l,n)*mmean(ig,l)/mmol(gind(n)) |
---|
| 181 | cpnew(ig,l) = cpnew(ig,l) + ni(n)*cpi(n) |
---|
| 182 | akknew(ig,l) = akknew(ig,l) + ni(n)*aki(n) |
---|
| 183 | end do |
---|
| 184 | cpnew(ig,l) = cpnew(ig,l)/ntot |
---|
| 185 | akknew(ig,l) = akknew(ig,l)/ntot |
---|
| 186 | end do |
---|
| 187 | c print*, l, mmean(1,l), cpnew(1,l), rnew(1,l) |
---|
| 188 | end do |
---|
[38] | 189 | |
---|
| 190 | return |
---|
| 191 | end |
---|