| 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 | real :: psats2,psats3,psats4,psats8 |
|---|
| 23 | real :: psats2l,psats3l,psats4l,psats8l |
|---|
| 24 | real :: psats2z,psats3z,psats4z,psats8z |
|---|
| 25 | real :: qsats2,qsats3,qsats4,qsats8 |
|---|
| 26 | real :: mms2,mms3,mms4,mms8 |
|---|
| 27 | real*8, dimension(nblon,nblev) :: s2t,s3t,s4t,s8t |
|---|
| 28 | real*8 :: epss2,epss3,epss4,epss8 |
|---|
| 29 | |
|---|
| 30 | ! >>> Program starts here: |
|---|
| 31 | |
|---|
| 32 | mms2 = 64.13 ! S2 molecular mass |
|---|
| 33 | mms3 = 96.198 ! S3 molecular mass |
|---|
| 34 | mms4 = 128.26 ! S4 molecular mass |
|---|
| 35 | mms8 = 256.52 ! S8 molecular mass |
|---|
| 36 | epss2 = mms2/43.44 |
|---|
| 37 | epss3 = mms3/43.44 |
|---|
| 38 | epss4 = mms4/43.44 |
|---|
| 39 | epss8 = mms8/43.44 |
|---|
| 40 | |
|---|
| 41 | s2t(:,:) = s2(:,:) + s2con(:,:) |
|---|
| 42 | s3t(:,:) = s3(:,:) + s3con(:,:) |
|---|
| 43 | s4t(:,:) = s4(:,:) + s4con(:,:) |
|---|
| 44 | s8t(:,:) = s8(:,:) + s8con(:,:) |
|---|
| 45 | s2con(:,:) = 0.0 |
|---|
| 46 | s3con(:,:) = 0.0 |
|---|
| 47 | s4con(:,:) = 0.0 |
|---|
| 48 | s8con(:,:) = 0.0 |
|---|
| 49 | |
|---|
| 50 | DO i = 1,nblon |
|---|
| 51 | DO k = 1,nblev |
|---|
| 52 | !Lyons 2008 ; Rimmer 2021 |
|---|
| 53 | psats2l = 1e5*10**(7.0240 - 6091.2/(TT(i,k))) ! S2 |
|---|
| 54 | psats3l = 1e5*10**(6.3428 - 6202.2/(TT(i,k))) ! S3 |
|---|
| 55 | psats4l = 1e5*10**(6.0028 - 6047.5/(TT(i,k))) ! S4 |
|---|
| 56 | psats8l = 1e5*10**(4.1879 - 3269.1/(TT(i,k))) ! S8 |
|---|
| 57 | !Zahnle 2016 |
|---|
| 58 | if (TT(i,k).gt.413) then |
|---|
| 59 | psats2z = 1e5*exp (16.1 - 14000/TT(i,k) ) |
|---|
| 60 | psats8z = 1e5*exp (9.6 - 7510/TT(i,k) ) |
|---|
| 61 | else |
|---|
| 62 | psats2z = 1e5*exp (27. - 18500/TT(i,k) ) |
|---|
| 63 | psats8z = 1e5*exp (20. - 11800/TT(i,k) ) |
|---|
| 64 | endif |
|---|
| 65 | psats2 = psats2z |
|---|
| 66 | psats8 = psats8z |
|---|
| 67 | rat = (psats2z/psats2l + psats8z/psats8l)/2. |
|---|
| 68 | psats3 = rat*psats3l |
|---|
| 69 | psats4 = rat*psats4l |
|---|
| 70 | |
|---|
| 71 | qsats2 = epss2*psats2/(PP(i,k) - psats2) |
|---|
| 72 | qsats3 = epss3*psats3/(PP(i,k) - psats3) |
|---|
| 73 | qsats4 = epss4*psats4/(PP(i,k) - psats4) |
|---|
| 74 | qsats8 = epss8*psats8/(PP(i,k) - psats8) |
|---|
| 75 | |
|---|
| 76 | if (s2t(i,k).gt.qsats2) then |
|---|
| 77 | s2con(i,k) = s2t(i,k) - qsats2 |
|---|
| 78 | s2(i,k) = qsats2 |
|---|
| 79 | endif |
|---|
| 80 | if (s3t(i,k).gt.qsats3) then |
|---|
| 81 | s3con(i,k) = s3t(i,k) - qsats3 |
|---|
| 82 | s3(i,k) = qsats3 |
|---|
| 83 | endif |
|---|
| 84 | if (s4t(i,k).gt.qsats4) then |
|---|
| 85 | s4con(i,k) = s4t(i,k) - qsats4 |
|---|
| 86 | s4(i,k) = qsats4 |
|---|
| 87 | endif |
|---|
| 88 | if (s8t(i,k).gt.qsats8) then |
|---|
| 89 | s8con(i,k) = s8t(i,k) - qsats8 |
|---|
| 90 | s8(i,k) = qsats8 |
|---|
| 91 | endif |
|---|
| 92 | |
|---|
| 93 | ENDDO |
|---|
| 94 | ENDDO |
|---|
| 95 | |
|---|
| 96 | END SUBROUTINE polysulfur_condens |
|---|
