| 1 | MODULE iono_h |
|---|
| 2 | |
|---|
| 3 | IMPLICIT NONE |
|---|
| 4 | |
|---|
| 5 | character*1,save,allocatable :: o1d_eq(:) |
|---|
| 6 | character*1,save,allocatable :: ho2_eq(:) |
|---|
| 7 | character*1,save,allocatable :: oh_eq(:) |
|---|
| 8 | character*1,save,allocatable :: h_eq(:) |
|---|
| 9 | character*1,save,allocatable :: n2d_eq(:) |
|---|
| 10 | character*1,save,allocatable :: no2_eq(:) |
|---|
| 11 | character*1,save,allocatable :: o3_eq(:) |
|---|
| 12 | character*1,save,allocatable :: no_eq(:) |
|---|
| 13 | character*1,save,allocatable :: cplus_eq(:) |
|---|
| 14 | character*1,save,allocatable :: coplus_eq(:) |
|---|
| 15 | character*1,save,allocatable :: oplus_eq(:) |
|---|
| 16 | character*1,save,allocatable :: n2plus_eq(:) |
|---|
| 17 | character*1,save,allocatable :: hplus_eq(:) |
|---|
| 18 | character*1,save,allocatable :: co2plus_eq(:) |
|---|
| 19 | character*1,save,allocatable :: o2plus_eq(:) |
|---|
| 20 | character*1,save,allocatable :: noplus_eq(:) |
|---|
| 21 | character*1,save,allocatable :: nplus_eq(:) |
|---|
| 22 | character*1,save,allocatable :: hco2plus_eq(:) |
|---|
| 23 | real*8,save,allocatable :: tauco2(:,:) |
|---|
| 24 | real*8,save,allocatable :: tauo2(:,:) |
|---|
| 25 | real*8,save,allocatable :: tauo3p(:,:) |
|---|
| 26 | real*8,save,allocatable :: tauco(:,:) |
|---|
| 27 | real*8,save,allocatable :: tauh(:,:) |
|---|
| 28 | real*8,save,allocatable :: tauoh(:,:) |
|---|
| 29 | real*8,save,allocatable :: tauho2(:,:) |
|---|
| 30 | real*8,save,allocatable :: tauh2(:,:) |
|---|
| 31 | real*8,save,allocatable :: tauh2o(:,:) |
|---|
| 32 | real*8,save,allocatable :: tauo1d(:,:) |
|---|
| 33 | real*8,save,allocatable :: tauh2o2(:,:) |
|---|
| 34 | real*8,save,allocatable :: tauo3(:,:) |
|---|
| 35 | real*8,save,allocatable :: taun(:,:) |
|---|
| 36 | real*8,save,allocatable :: tauno(:,:) |
|---|
| 37 | real*8,save,allocatable :: taun2(:,:) |
|---|
| 38 | real*8,save,allocatable :: taun2d(:,:) |
|---|
| 39 | real*8,save,allocatable :: tauno2(:,:) |
|---|
| 40 | real*8,save,allocatable :: tauco2plus(:,:) |
|---|
| 41 | real*8,save,allocatable :: tauoplus(:,:) |
|---|
| 42 | real*8,save,allocatable :: tauo2plus(:,:) |
|---|
| 43 | real*8,save,allocatable :: taucoplus(:,:) |
|---|
| 44 | real*8,save,allocatable :: taucplus(:,:) |
|---|
| 45 | real*8,save,allocatable :: taunplus(:,:) |
|---|
| 46 | real*8,save,allocatable :: taunoplus(:,:) |
|---|
| 47 | real*8,save,allocatable :: taun2plus(:,:) |
|---|
| 48 | real*8,save,allocatable :: tauhplus(:,:) |
|---|
| 49 | real*8,save,allocatable :: tauhco2plus(:,:) |
|---|
| 50 | |
|---|
| 51 | !$OMP THREADPRIVATE(o1d_eq,ho2_eq,oh_eq,h_eq,n2d_eq,no2_eq,o3_eq,no_eq,cplus_eq,coplus_eq,oplus_eq) |
|---|
| 52 | !$OMP THREADPRIVATE(n2plus_eq,hplus_eq,co2plus_eq,o2plus_eq,noplus_eq,nplus_eq,hco2plus_eq,tauco2,tauo2,tauo3p,tauco,tauh,tauoh,tauho2,tauh2) |
|---|
| 53 | !$OMP THREADPRIVATE(tauh2o,tauo1d,tauh2o2,tauo3,taun,tauno,taun2,taun2d,tauno2,tauco2plus,tauoplus,tauo2plus,taucoplus,taucplus,taunplus,taunoplus,taun2plus,tauhplus,tauhco2plus) |
|---|
| 54 | |
|---|
| 55 | CONTAINS |
|---|
| 56 | |
|---|
| 57 | SUBROUTINE allocate_param_iono(nlayer,nreact) |
|---|
| 58 | |
|---|
| 59 | IMPLICIT NONE |
|---|
| 60 | |
|---|
| 61 | INTEGER :: nreact |
|---|
| 62 | INTEGER :: nlayer |
|---|
| 63 | |
|---|
| 64 | allocate(o1d_eq(nlayer)) |
|---|
| 65 | allocate(ho2_eq(nlayer)) |
|---|
| 66 | allocate(oh_eq(nlayer)) |
|---|
| 67 | allocate(h_eq(nlayer)) |
|---|
| 68 | allocate(n2d_eq(nlayer)) |
|---|
| 69 | allocate(no2_eq(nlayer)) |
|---|
| 70 | allocate(o3_eq(nlayer)) |
|---|
| 71 | allocate(no_eq(nlayer)) |
|---|
| 72 | allocate(cplus_eq(nlayer)) |
|---|
| 73 | allocate(coplus_eq(nlayer)) |
|---|
| 74 | allocate(oplus_eq(nlayer)) |
|---|
| 75 | allocate(n2plus_eq(nlayer)) |
|---|
| 76 | allocate(hplus_eq(nlayer)) |
|---|
| 77 | allocate(co2plus_eq(nlayer)) |
|---|
| 78 | allocate(o2plus_eq(nlayer)) |
|---|
| 79 | allocate(noplus_eq(nlayer)) |
|---|
| 80 | allocate(nplus_eq(nlayer)) |
|---|
| 81 | allocate(hco2plus_eq(nlayer)) |
|---|
| 82 | allocate(tauco2(nreact,nlayer)) |
|---|
| 83 | allocate(tauo2(nreact,nlayer)) |
|---|
| 84 | allocate(tauo3p(nreact,nlayer)) |
|---|
| 85 | allocate(tauco(nreact,nlayer)) |
|---|
| 86 | allocate(tauh(nreact,nlayer)) |
|---|
| 87 | allocate(tauoh(nreact,nlayer)) |
|---|
| 88 | allocate(tauho2(nreact,nlayer)) |
|---|
| 89 | allocate(tauh2(nreact,nlayer)) |
|---|
| 90 | allocate(tauh2o(nreact,nlayer)) |
|---|
| 91 | allocate(tauo1d(nreact,nlayer)) |
|---|
| 92 | allocate(tauh2o2(nreact,nlayer)) |
|---|
| 93 | allocate(tauo3(nreact,nlayer)) |
|---|
| 94 | allocate(taun(nreact,nlayer)) |
|---|
| 95 | allocate(tauno(nreact,nlayer)) |
|---|
| 96 | allocate(taun2(nreact,nlayer)) |
|---|
| 97 | allocate(taun2d(nreact,nlayer)) |
|---|
| 98 | allocate(tauno2(nreact,nlayer)) |
|---|
| 99 | allocate(tauco2plus(nreact,nlayer)) |
|---|
| 100 | allocate(tauoplus(nreact,nlayer)) |
|---|
| 101 | allocate(tauo2plus(nreact,nlayer)) |
|---|
| 102 | allocate(taucoplus(nreact,nlayer)) |
|---|
| 103 | allocate(taucplus(nreact,nlayer)) |
|---|
| 104 | allocate(taunplus(nreact,nlayer)) |
|---|
| 105 | allocate(taunoplus(nreact,nlayer)) |
|---|
| 106 | allocate(taun2plus(nreact,nlayer)) |
|---|
| 107 | allocate(tauhplus(nreact,nlayer)) |
|---|
| 108 | allocate(tauhco2plus(nreact,nlayer)) |
|---|
| 109 | |
|---|
| 110 | END SUBROUTINE allocate_param_iono |
|---|
| 111 | |
|---|
| 112 | |
|---|
| 113 | !*********************************************************************** |
|---|
| 114 | function temp_elect(zkm,tt,origin) |
|---|
| 115 | |
|---|
| 116 | ! Computes the electronic temperature, either from Viking (origin=1) |
|---|
| 117 | ! or MAVEN (origin=2) |
|---|
| 118 | |
|---|
| 119 | !*********************************************************************** |
|---|
| 120 | |
|---|
| 121 | ! Arguments |
|---|
| 122 | |
|---|
| 123 | real tt ! Temperature |
|---|
| 124 | real zkm ! Altitude in km |
|---|
| 125 | integer origin ! Viking (origin=1) or MAVEN (origin=2) |
|---|
| 126 | |
|---|
| 127 | ! local variables: |
|---|
| 128 | real temp_elect ! electronic temperatures |
|---|
| 129 | real zhanson(9),tehanson(9) |
|---|
| 130 | real incremento |
|---|
| 131 | integer ii, i1, i2 |
|---|
| 132 | |
|---|
| 133 | zhanson(1:9) = (/ 120.,130.,150.,175.,200.,225.,250.,275.,300. /) |
|---|
| 134 | tehanson(2:9) = (/ 200.,300.,500.,1250.,2000.,2200.,2400.,2500. /) |
|---|
| 135 | tehanson(1) = tt |
|---|
| 136 | |
|---|
| 137 | if(origin.eq.1) then |
|---|
| 138 | if ( zkm .le. 120. ) then |
|---|
| 139 | temp_elect = tt |
|---|
| 140 | else if(zkm .ge.300.) then |
|---|
| 141 | temp_elect=tehanson(9) |
|---|
| 142 | else |
|---|
| 143 | do ii=9,2,-1 |
|---|
| 144 | if ( zkm .lt. zhanson(ii) ) then |
|---|
| 145 | i1 = ii - 1 |
|---|
| 146 | i2 = ii |
|---|
| 147 | endif |
|---|
| 148 | enddo |
|---|
| 149 | incremento=(tehanson(i2)-tehanson(i1))/(zhanson(i2)-zhanson(i1)) |
|---|
| 150 | temp_elect = tehanson(i1) + (zkm-zhanson(i1)) * incremento |
|---|
| 151 | endif |
|---|
| 152 | else if(origin.eq.2) then |
|---|
| 153 | !MAVEN measured electronic temperature (Ergun et al., GRL 2015) |
|---|
| 154 | !Note that the Langmuir probe is not sensitive below ~500K, so |
|---|
| 155 | !electronic temperatures in the lower thermosphere (<150 km) may |
|---|
| 156 | !be overestimated by this formula |
|---|
| 157 | if(zkm.le.120) then |
|---|
| 158 | temp_elect = tt |
|---|
| 159 | else |
|---|
| 160 | temp_elect=((3140.+120.)/2.)+((3140.-120.)/2.)*tanh((zkm-241.)/60.) |
|---|
| 161 | endif |
|---|
| 162 | else |
|---|
| 163 | write(*,*)'Error in function temp_elect:' |
|---|
| 164 | write(*,*)'Origin must be either 1 or 2' |
|---|
| 165 | write(*,*)'Using neutral temperature instead' |
|---|
| 166 | temp_elect = tt |
|---|
| 167 | endif |
|---|
| 168 | |
|---|
| 169 | return |
|---|
| 170 | |
|---|
| 171 | end function temp_elect |
|---|
| 172 | |
|---|
| 173 | END MODULE iono_h |
|---|
