| 1 | SUBROUTINE polysulfur_condens( |
|---|
| 2 | + nblev, nblon, |
|---|
| 3 | + TT,PP, |
|---|
| 4 | + s2,s3,s4,s8, |
|---|
| 5 | + s2con,s3con,s4con,s8con) |
|---|
| 6 | |
|---|
| 7 | USE chemparam_mod |
|---|
| 8 | IMPLICIT NONE |
|---|
| 9 | |
|---|
| 10 | INTEGER, INTENT(IN) :: nblon ! nombre de points horizontaux |
|---|
| 11 | INTEGER, INTENT(IN) :: nblev ! nombre de couches verticales |
|---|
| 12 | |
|---|
| 13 | !---------------------------------------------------------------------------- |
|---|
| 14 | ! Ambient air state variables: |
|---|
| 15 | REAL, INTENT(INOUT), DIMENSION(nblon,nblev) :: s2,s3,s4,s8,TT,PP |
|---|
| 16 | REAL, INTENT(INOUT), DIMENSION(nblon,nblev) :: s2con,s3con,s4con, |
|---|
| 17 | + s8con |
|---|
| 18 | !---------------------------------------------------------------------------- |
|---|
| 19 | INTEGER :: i,k |
|---|
| 20 | !---------------------------------------------------------------------------- |
|---|
| 21 | real :: rat |
|---|
| 22 | ! Saturation vapor pressure of Sx (Pa) |
|---|
| 23 | real :: psats2,psats3,psats4,psats8 |
|---|
| 24 | ! Saturation vapor pressure of Sx (Pa) from Lyons et al., 2008 |
|---|
| 25 | real :: psats2l,psats3l,psats4l,psats8l |
|---|
| 26 | ! Saturation vapor pressure of Sx (Pa) from Zahnle et al., 2016 |
|---|
| 27 | real :: psats2z,psats3z,psats4z,psats8z |
|---|
| 28 | ! VMR equivalent of P_sat of Sx |
|---|
| 29 | real :: qsats2,qsats3,qsats4,qsats8 |
|---|
| 30 | ! Ratios of Sx molec mass over Venus atm mean molec mass |
|---|
| 31 | real, parameter :: epss2 = 64.13/43.44 |
|---|
| 32 | real, parameter :: epss3 = 96.198/43.44 |
|---|
| 33 | real, parameter :: epss4 = 128.26/43.44 |
|---|
| 34 | real, parameter :: epss8 = 256.52/43.44 |
|---|
| 35 | ! Local total VMR of Sx |
|---|
| 36 | real, dimension(nblon,nblev) :: s2t,s3t,s4t,s8t |
|---|
| 37 | |
|---|
| 38 | ! >>> Program starts here: |
|---|
| 39 | |
|---|
| 40 | ! Init of total Sx |
|---|
| 41 | s2t(:,:) = s2(:,:) + s2con(:,:) |
|---|
| 42 | s3t(:,:) = s3(:,:) + s3con(:,:) |
|---|
| 43 | s4t(:,:) = s4(:,:) + s4con(:,:) |
|---|
| 44 | s8t(:,:) = s8(:,:) + s8con(:,:) |
|---|
| 45 | ! Condensed parts then set up to minimal value |
|---|
| 46 | s2con(:,:) = 1e-30 |
|---|
| 47 | s3con(:,:) = 1e-30 |
|---|
| 48 | s4con(:,:) = 1e-30 |
|---|
| 49 | s8con(:,:) = 1e-30 |
|---|
| 50 | ! Gas part set up to total |
|---|
| 51 | s2(:,:) = s2t(:,:) |
|---|
| 52 | s3(:,:) = s3t(:,:) |
|---|
| 53 | s4(:,:) = s4t(:,:) |
|---|
| 54 | s8(:,:) = s8t(:,:) |
|---|
| 55 | |
|---|
| 56 | |
|---|
| 57 | ! Loop all over Venus |
|---|
| 58 | DO k = 1,nblev |
|---|
| 59 | DO i = 1,nblon |
|---|
| 60 | !Lyons 2008 ; Rimmer 2021 |
|---|
| 61 | psats2l = 1e5*10**(7.0240 - 6091.2/(TT(i,k))) ! S2 |
|---|
| 62 | psats3l = 1e5*10**(6.3428 - 6202.2/(TT(i,k))) ! S3 |
|---|
| 63 | psats4l = 1e5*10**(6.0028 - 6047.5/(TT(i,k))) ! S4 |
|---|
| 64 | psats8l = 1e5*10**(4.1879 - 3269.1/(TT(i,k))) ! S8 |
|---|
| 65 | !Zahnle 2016 |
|---|
| 66 | if (TT(i,k).gt.413.) then |
|---|
| 67 | psats2z = 1e5*exp(16.1 - 14000./TT(i,k)) |
|---|
| 68 | psats8z = 1e5*exp(9.6 - 7510./TT(i,k)) |
|---|
| 69 | else |
|---|
| 70 | psats2z = 1e5*exp(27. - 18500./TT(i,k)) |
|---|
| 71 | psats8z = 1e5*exp(20. - 11800./TT(i,k)) |
|---|
| 72 | endif |
|---|
| 73 | psats2 = psats2z |
|---|
| 74 | psats8 = psats8z |
|---|
| 75 | !Zahnle 2016 does not have S3, S4. |
|---|
| 76 | !Using the average of the ratio between the two sets |
|---|
| 77 | rat = (psats2z/psats2l + psats8z/psats8l)/2. |
|---|
| 78 | psats3 = rat*psats3l |
|---|
| 79 | psats4 = rat*psats4l |
|---|
| 80 | |
|---|
| 81 | ! Check the atm P condition to Psat S2 |
|---|
| 82 | ! If condition is met, condensation |
|---|
| 83 | ! Otherwise Sx_gas and Sx_cond stays as initialized |
|---|
| 84 | if (PP(i,k).gt.psats2) then |
|---|
| 85 | qsats2 = psats2/(PP(i,k)) |
|---|
| 86 | if (s2t(i,k).gt.qsats2) then |
|---|
| 87 | s2con(i,k) = s2t(i,k) - qsats2 |
|---|
| 88 | s2(i,k) = qsats2 |
|---|
| 89 | endif |
|---|
| 90 | endif |
|---|
| 91 | |
|---|
| 92 | ! Check the atm P condition to Psat S3 |
|---|
| 93 | ! If condition is met, condensation |
|---|
| 94 | ! Otherwise Sx_gas and Sx_cond stays as initialized |
|---|
| 95 | if (PP(i,k).gt.psats3) then |
|---|
| 96 | qsats3 = psats3/(PP(i,k)) |
|---|
| 97 | if (s3t(i,k).gt.qsats3) then |
|---|
| 98 | s3con(i,k) = s3t(i,k) - qsats3 |
|---|
| 99 | s3(i,k) = qsats3 |
|---|
| 100 | endif |
|---|
| 101 | endif |
|---|
| 102 | |
|---|
| 103 | ! Check the atm P condition to Psat S4 |
|---|
| 104 | ! If condition is met, condensation |
|---|
| 105 | ! Otherwise Sx_gas and Sx_cond stays as initialized |
|---|
| 106 | if (PP(i,k).gt.psats4) then |
|---|
| 107 | qsats4 = psats4/(PP(i,k)) |
|---|
| 108 | if (s4t(i,k).gt.qsats4) then |
|---|
| 109 | s4con(i,k) =s4t(i,k) - qsats4 |
|---|
| 110 | s4(i,k) = qsats4 |
|---|
| 111 | endif |
|---|
| 112 | endif |
|---|
| 113 | |
|---|
| 114 | ! Check the atm P condition to Psat S8 |
|---|
| 115 | ! If condition is met, condensation |
|---|
| 116 | ! Otherwise Sx_gas and Sx_cond stays as initialized |
|---|
| 117 | if (PP(i,k).gt.psats8) then |
|---|
| 118 | qsats8 = psats8/(PP(i,k)) |
|---|
| 119 | if (s8t(i,k).gt.qsats8) then |
|---|
| 120 | s8con(i,k) = s8t(i,k) - qsats8 |
|---|
| 121 | s8(i,k) = qsats8 |
|---|
| 122 | endif |
|---|
| 123 | endif |
|---|
| 124 | ENDDO |
|---|
| 125 | ENDDO |
|---|
| 126 | |
|---|
| 127 | END SUBROUTINE polysulfur_condens |
|---|
