| 1 | c********************************************************************** |
|---|
| 2 | |
|---|
| 3 | subroutine hrtherm |
|---|
| 4 | $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit,jtot) |
|---|
| 5 | |
|---|
| 6 | |
|---|
| 7 | c feb 2002 fgg first version |
|---|
| 8 | c nov 2002 fgg second version |
|---|
| 9 | |
|---|
| 10 | c********************************************************************** |
|---|
| 11 | |
|---|
| 12 | implicit none |
|---|
| 13 | |
|---|
| 14 | c common variables and constants |
|---|
| 15 | |
|---|
| 16 | include 'param.h' |
|---|
| 17 | include 'param_v3.h' |
|---|
| 18 | include 'callkeys.h' |
|---|
| 19 | |
|---|
| 20 | |
|---|
| 21 | c local parameters and variables |
|---|
| 22 | |
|---|
| 23 | real xabsi(nabs,nzmax) !densities |
|---|
| 24 | real nada |
|---|
| 25 | real jergs(ninter,nabs,nzmax) |
|---|
| 26 | |
|---|
| 27 | integer i,j,k,indexint !indexes |
|---|
| 28 | character dn |
|---|
| 29 | |
|---|
| 30 | |
|---|
| 31 | c input and output variables |
|---|
| 32 | |
|---|
| 33 | integer nz !number of layers |
|---|
| 34 | real co2x(nz) !density of CO2(cm^-3) |
|---|
| 35 | real o2x(nz) !density of O2(cm^-3) |
|---|
| 36 | real o3px(nz) !density of O(3P)(cm^-3) |
|---|
| 37 | real h2x(nz) !density of H2(cm^-3) |
|---|
| 38 | real h2ox(nz) !density of H2O(cm^-3) |
|---|
| 39 | real h2o2x(nz) !density of H2O2(cm^-3) |
|---|
| 40 | real aux1(nz) !auxiliar variable |
|---|
| 41 | real aux2(nz) !auxiliar variable |
|---|
| 42 | real jtot(nz) !output: heating rate(erg/s) |
|---|
| 43 | real tx(nz) !temperature |
|---|
| 44 | real date |
|---|
| 45 | real zenit |
|---|
| 46 | real iz(nz) |
|---|
| 47 | |
|---|
| 48 | logical firstcall |
|---|
| 49 | save firstcall |
|---|
| 50 | data firstcall /.true./ |
|---|
| 51 | |
|---|
| 52 | c*************************PROGRAM STARTS******************************* |
|---|
| 53 | |
|---|
| 54 | c if (firstcall) then |
|---|
| 55 | c if(.not. thermochem) call param_read |
|---|
| 56 | c firstcall= .false. |
|---|
| 57 | c endif |
|---|
| 58 | |
|---|
| 59 | if(zenit.gt.100.) then |
|---|
| 60 | dn='n' |
|---|
| 61 | else |
|---|
| 62 | dn='d' |
|---|
| 63 | end if |
|---|
| 64 | if(dn.eq.'n') then |
|---|
| 65 | do i=1,nz |
|---|
| 66 | jtot(i)=0. |
|---|
| 67 | enddo |
|---|
| 68 | return |
|---|
| 69 | endif |
|---|
| 70 | |
|---|
| 71 | do i=1,nz |
|---|
| 72 | xabsi(1,i) = co2x(i) |
|---|
| 73 | xabsi(2,i) = o2x(i) |
|---|
| 74 | xabsi(3,i) = o3px(i) |
|---|
| 75 | xabsi(4,i) = h2ox(i) |
|---|
| 76 | xabsi(5,i) = h2x(i) |
|---|
| 77 | xabsi(6,i) = h2o2x(i) |
|---|
| 78 | jtot(i) = 0. |
|---|
| 79 | end do |
|---|
| 80 | |
|---|
| 81 | if(.not. thermochem) then |
|---|
| 82 | call jthermcalc |
|---|
| 83 | $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit) |
|---|
| 84 | endif |
|---|
| 85 | |
|---|
| 86 | do i=1,nz |
|---|
| 87 | do j=1,nabs |
|---|
| 88 | do indexint=1,33 |
|---|
| 89 | jergs(indexint,j,i) = jfotsout(indexint,j,i) |
|---|
| 90 | $ * xabsi (j,i) * fluxtop(indexint) |
|---|
| 91 | $ / (0.5e9 * freccen(indexint)) |
|---|
| 92 | jtot(i)=jtot(i)+jergs(indexint,j,i) |
|---|
| 93 | end do |
|---|
| 94 | end do |
|---|
| 95 | end do |
|---|
| 96 | |
|---|
| 97 | return |
|---|
| 98 | |
|---|
| 99 | end |
|---|
| 100 | |
|---|
