| 1 | SUBROUTINE chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress, |
|---|
| 2 | $ zlocal,zenit,ptimestep,zday) |
|---|
| 3 | |
|---|
| 4 | IMPLICIT NONE |
|---|
| 5 | c======================================================================= |
|---|
| 6 | c subject: |
|---|
| 7 | c -------- |
|---|
| 8 | c Computing chemical variations in the thermosphere |
|---|
| 9 | c |
|---|
| 10 | c author: MAC July 2003 |
|---|
| 11 | c ------ |
|---|
| 12 | c======================================================================= |
|---|
| 13 | c |
|---|
| 14 | c 0. Declarations : |
|---|
| 15 | c ------------------ |
|---|
| 16 | c |
|---|
| 17 | #include "dimensions.h" |
|---|
| 18 | #include "dimphys.h" |
|---|
| 19 | #include "comcstfi.h" |
|---|
| 20 | #include "callkeys.h" |
|---|
| 21 | #include "comdiurn.h" |
|---|
| 22 | #include "param.h" |
|---|
| 23 | #include "param_v3.h" |
|---|
| 24 | #include "chimiedata.h" |
|---|
| 25 | #include "conc.h" |
|---|
| 26 | c----------------------------------------------------------------------- |
|---|
| 27 | c Input/Output |
|---|
| 28 | c ------------ |
|---|
| 29 | INTEGER lswitch,ig |
|---|
| 30 | |
|---|
| 31 | REAL zday,zycol(nlayermx,nqmx) |
|---|
| 32 | REAL ptimestep |
|---|
| 33 | real zenit |
|---|
| 34 | real ztemp(nlayermx) |
|---|
| 35 | real zdens(nlayermx) |
|---|
| 36 | real zpress(nlayermx) ! in mbar |
|---|
| 37 | c |
|---|
| 38 | c Local variables : |
|---|
| 39 | c ----------------- |
|---|
| 40 | INTEGER nlayer,l,nesptherm |
|---|
| 41 | parameter (nesptherm = 11) |
|---|
| 42 | real tmean |
|---|
| 43 | real aux1(nlayermx),aux2(nlayermx) |
|---|
| 44 | real zlocal(nlayermx) |
|---|
| 45 | real rm(nlayermx,nesptherm) !number density (cm-3) |
|---|
| 46 | |
|---|
| 47 | integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2, |
|---|
| 48 | $ i_o1d, i_o, i_h, i_oh, i_ho2 |
|---|
| 49 | integer g_co2, g_co, g_o2, g_h2, g_h2o, g_h2o2, |
|---|
| 50 | $ g_o1d, g_o, g_h, g_oh, g_ho2, g_o3, g_n2 |
|---|
| 51 | |
|---|
| 52 | logical firstcall |
|---|
| 53 | save firstcall |
|---|
| 54 | data firstcall /.true./ |
|---|
| 55 | |
|---|
| 56 | c if (firstcall) then |
|---|
| 57 | c call param_read |
|---|
| 58 | c firstcall= .false. |
|---|
| 59 | c endif |
|---|
| 60 | |
|---|
| 61 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
|---|
| 62 | c tracer numbering in the gcm |
|---|
| 63 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
|---|
| 64 | c |
|---|
| 65 | g_co2 = nqchem_min |
|---|
| 66 | g_co = nqchem_min + 1 |
|---|
| 67 | g_o = nqchem_min + 2 |
|---|
| 68 | g_o1d = nqchem_min + 3 |
|---|
| 69 | g_o2 = nqchem_min + 4 |
|---|
| 70 | g_o3 = nqchem_min + 5 |
|---|
| 71 | g_h = nqchem_min + 6 |
|---|
| 72 | g_h2 = nqchem_min + 7 |
|---|
| 73 | g_oh = nqchem_min + 8 |
|---|
| 74 | g_ho2 = nqchem_min + 9 |
|---|
| 75 | g_h2o2 = nqchem_min + 10 |
|---|
| 76 | g_n2 = nqchem_min + 11 |
|---|
| 77 | g_h2o = nqmx |
|---|
| 78 | |
|---|
| 79 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
|---|
| 80 | c tracer numbering in the thermospheric chemistry |
|---|
| 81 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
|---|
| 82 | c |
|---|
| 83 | i_co2 = 1 |
|---|
| 84 | i_o2 = 2 |
|---|
| 85 | i_o = 3 |
|---|
| 86 | i_co = 4 |
|---|
| 87 | i_h = 5 |
|---|
| 88 | i_oh = 6 |
|---|
| 89 | i_ho2 = 7 |
|---|
| 90 | i_h2 = 8 |
|---|
| 91 | i_h2o = 9 |
|---|
| 92 | i_h2o2 = 10 |
|---|
| 93 | i_o1d = 11 |
|---|
| 94 | c |
|---|
| 95 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
|---|
| 96 | |
|---|
| 97 | nlayer=nlayermx |
|---|
| 98 | c zlocal(1)=0.00625 |
|---|
| 99 | c do l=2,nlayer |
|---|
| 100 | c tmean=ztemp(l) |
|---|
| 101 | c if(ztemp(l).ne.ztemp(l-1)) |
|---|
| 102 | c & tmean=(ztemp(l)-ztemp(l-1))/log(ztemp(l)/ztemp(l-1)) |
|---|
| 103 | c zlocal(l)= zlocal(l-1)-log(zpress(l)/zpress(l-1)) |
|---|
| 104 | c & *Rnew(ig,l-1)*tmean/g/1000. |
|---|
| 105 | c enddo |
|---|
| 106 | |
|---|
| 107 | do l=1,nlayer |
|---|
| 108 | aux1(l)=0. |
|---|
| 109 | aux2(l)=0. |
|---|
| 110 | rm(l,i_co2) = zycol(l,g_co2) *zdens(l) |
|---|
| 111 | rm(l,i_co) = zycol(l,g_co) *zdens(l) |
|---|
| 112 | rm(l,i_o) = zycol(l,g_o) *zdens(l) |
|---|
| 113 | rm(l,i_o1d) = zycol(l,g_o1d) *zdens(l) |
|---|
| 114 | rm(l,i_o2) = zycol(l,g_o2) *zdens(l) |
|---|
| 115 | rm(l,i_h) = zycol(l,g_h) *zdens(l) |
|---|
| 116 | rm(l,i_h2) = zycol(l,g_h2) *zdens(l) |
|---|
| 117 | rm(l,i_oh) = zycol(l,g_oh) *zdens(l) |
|---|
| 118 | rm(l,i_ho2) = zycol(l,g_ho2) *zdens(l) |
|---|
| 119 | rm(l,i_h2o2) = zycol(l,g_h2o2) *zdens(l) |
|---|
| 120 | rm(l,i_h2o) = zycol(l,g_h2o) *zdens(l) |
|---|
| 121 | enddo |
|---|
| 122 | |
|---|
| 123 | call flujo(solarcondate+zday/365.) |
|---|
| 124 | |
|---|
| 125 | call jthermcalc |
|---|
| 126 | $ (rm(1,i_co2),rm(1,i_o2),rm(1,i_o),rm(1,i_h2),rm(1,i_h2o), |
|---|
| 127 | & rm(1,i_h2o2),aux1,aux2,ztemp,nlayermx,zlocal, |
|---|
| 128 | & solarcondate+zday/365.,zenit) |
|---|
| 129 | |
|---|
| 130 | call paramfoto(lswitch,zdens,ztemp,ptimestep/3600.,zenit, |
|---|
| 131 | & nlayer,rm(1,i_co2),rm(1,i_o2),rm(1,i_o), |
|---|
| 132 | & rm(1,i_co),rm(1,i_h),rm(1,i_oh),rm(1,i_ho2), |
|---|
| 133 | & rm(1,i_h2),rm(1,i_h2o),rm(1,i_h2o2),rm(1,i_o1d)) |
|---|
| 134 | |
|---|
| 135 | do l=lswitch,nlayer |
|---|
| 136 | zycol(l,g_co2) = max(rm(l,i_co2) / zdens(l) , 1.e-30) |
|---|
| 137 | zycol(l,g_co) = max(rm(l,i_co) / zdens(l) , 1.E-30) |
|---|
| 138 | zycol(l,g_o2) = max(rm(l,i_o2) / zdens(l) , 1.e-30) |
|---|
| 139 | zycol(l,g_h2) = max(rm(l,i_h2) / zdens(l) , 1.e-30) |
|---|
| 140 | zycol(l,g_h) = max(rm(l,i_h) / zdens(l) , 1.e-30) |
|---|
| 141 | zycol(l,g_oh) = max(rm(l,i_oh) / zdens(l) , 1.e-30) |
|---|
| 142 | zycol(l,g_ho2) = max(rm(l,i_ho2) / zdens(l) , 1.e-30) |
|---|
| 143 | zycol(l,g_h2o) = max(rm(l,i_h2o) / zdens(l) , 1.e-30) |
|---|
| 144 | zycol(l,g_h2o2) = max(rm(l,i_h2o2) / zdens(l) , 1.e-30) |
|---|
| 145 | zycol(l,g_o1d) = max(rm(l,i_o1d) / zdens(l) , 1.e-30) |
|---|
| 146 | zycol(l,g_o) = max(rm(l,i_o) / zdens(l) , 1.e-30) |
|---|
| 147 | enddo !nlayer |
|---|
| 148 | |
|---|
| 149 | |
|---|
| 150 | return |
|---|
| 151 | end |
|---|
