| 1 | SUBROUTINE SW_venus_ve( PRMU0, PFRAC, |
|---|
| 2 | S PPB, pt, pz, |
|---|
| 3 | S PHEAT, |
|---|
| 4 | S PTOPSW,PSOLSW,ZFSNET) |
|---|
| 5 | |
|---|
| 6 | use dimphy |
|---|
| 7 | use cpdet_mod, only: cpdet |
|---|
| 8 | IMPLICIT none |
|---|
| 9 | |
|---|
| 10 | #include "dimensions.h" |
|---|
| 11 | #include "YOMCST.h" |
|---|
| 12 | C |
|---|
| 13 | C ------------------------------------------------------------------ |
|---|
| 14 | C |
|---|
| 15 | C PURPOSE. |
|---|
| 16 | C -------- |
|---|
| 17 | C |
|---|
| 18 | c this routine loads and interpolates the shortwave radiation |
|---|
| 19 | c fluxes and heating rates computed from Vincent Eymet 3D MC code |
|---|
| 20 | C |
|---|
| 21 | C AUTHOR. |
|---|
| 22 | C ------- |
|---|
| 23 | C Sebastien Lebonnois |
|---|
| 24 | C |
|---|
| 25 | C MODIFICATIONS. |
|---|
| 26 | C -------------- |
|---|
| 27 | C ORIGINAL : 06/2014 |
|---|
| 28 | C ------------------------------------------------------------------ |
|---|
| 29 | C |
|---|
| 30 | C* ARGUMENTS: |
|---|
| 31 | C |
|---|
| 32 | c inputs |
|---|
| 33 | |
|---|
| 34 | REAL PRMU0 ! COSINE OF ZENITHAL ANGLE |
|---|
| 35 | REAL PFRAC ! fraction de la journee |
|---|
| 36 | REAL PPB(klev+1) ! inter-couches PRESSURE (bar) |
|---|
| 37 | REAL pt(klev) ! mid-layer temperature |
|---|
| 38 | REAL pz(klev+1) ! inter-couches altitude (m) |
|---|
| 39 | C |
|---|
| 40 | c output |
|---|
| 41 | |
|---|
| 42 | REAL PHEAT(klev) ! SHORTWAVE HEATING (K/VENUSDAY) within each layer |
|---|
| 43 | REAL PTOPSW ! SHORTWAVE FLUX AT T.O.A. (net) |
|---|
| 44 | REAL PSOLSW ! SHORTWAVE FLUX AT SURFACE (net) |
|---|
| 45 | REAL ZFSNET(klev+1) ! net solar flux at ppb levels |
|---|
| 46 | |
|---|
| 47 | C |
|---|
| 48 | C* LOCAL VARIABLES: |
|---|
| 49 | C |
|---|
| 50 | integer nlve,nszave |
|---|
| 51 | parameter (nlve=78) ! fichiers planet_EMC |
|---|
| 52 | parameter (nszave=20) ! fichiers planet_EMC |
|---|
| 53 | |
|---|
| 54 | integer i,j,nsza,nsza0,nl0 |
|---|
| 55 | real solarrate ! solar heating rate (K/earthday) |
|---|
| 56 | real zsnet(nlve,nszave) ! net solar flux (W/m**2) (+ vers bas) |
|---|
| 57 | real zheat(nlve-1,nszave) ! rad budget (W/m**2) |
|---|
| 58 | real zsdn,zsup ! downward/upward solar flux (W/m**2) |
|---|
| 59 | real solza(nszave) ! solar zenith angles in table (rad) |
|---|
| 60 | real altve(nlve) ! altitude in table (m) |
|---|
| 61 | real zsolnet(nlve) ! for testing mean net solar flux |
|---|
| 62 | character*22 nullchar |
|---|
| 63 | real sza0,factsza,factflux,alt |
|---|
| 64 | logical firstcall |
|---|
| 65 | data firstcall/.true./ |
|---|
| 66 | save solza,zsnet,altve,zheat |
|---|
| 67 | save firstcall |
|---|
| 68 | |
|---|
| 69 | c ------------------------ |
|---|
| 70 | c Loading the files |
|---|
| 71 | c ------------------------ |
|---|
| 72 | |
|---|
| 73 | if (firstcall) then |
|---|
| 74 | |
|---|
| 75 | ! FLUXES (W/m2) |
|---|
| 76 | |
|---|
| 77 | open(11,file='solar_fluxes_GCM.dat') |
|---|
| 78 | read(11,*) nullchar |
|---|
| 79 | read(11,*) nullchar |
|---|
| 80 | read(11,*) nullchar |
|---|
| 81 | read(11,*) nullchar |
|---|
| 82 | |
|---|
| 83 | do nsza=1,nszave |
|---|
| 84 | read(11,*) nullchar |
|---|
| 85 | read(11,*) solza(nsza) |
|---|
| 86 | read(11,*) nullchar |
|---|
| 87 | read(11,*) nullchar |
|---|
| 88 | do j=1,nlve |
|---|
| 89 | read(11,'(4(2x,F12.5))') |
|---|
| 90 | . altve(j),zsdn,zsup,zsnet(j,nsza) |
|---|
| 91 | enddo |
|---|
| 92 | enddo |
|---|
| 93 | |
|---|
| 94 | close(11) |
|---|
| 95 | |
|---|
| 96 | ! HEATING RATES (W/m2) |
|---|
| 97 | |
|---|
| 98 | open(12,file='solar_budgets_GCM.dat') |
|---|
| 99 | read(12,*) nullchar |
|---|
| 100 | read(12,*) nullchar |
|---|
| 101 | read(12,*) nullchar |
|---|
| 102 | read(12,*) nullchar |
|---|
| 103 | |
|---|
| 104 | do nsza=1,nszave |
|---|
| 105 | read(12,*) nullchar |
|---|
| 106 | read(12,*) solza(nsza) |
|---|
| 107 | read(12,*) nullchar |
|---|
| 108 | read(12,*) nullchar |
|---|
| 109 | do j=1,nlve-1 |
|---|
| 110 | read(12,'(2(2x,F12.5))') |
|---|
| 111 | . alt,zheat(j,nsza) |
|---|
| 112 | enddo |
|---|
| 113 | enddo |
|---|
| 114 | |
|---|
| 115 | close(12) |
|---|
| 116 | |
|---|
| 117 | firstcall=.false. |
|---|
| 118 | endif |
|---|
| 119 | |
|---|
| 120 | c -------------------------------------- |
|---|
| 121 | c Interpolation in the GCM vertical grid |
|---|
| 122 | c -------------------------------------- |
|---|
| 123 | |
|---|
| 124 | c Zenith angle |
|---|
| 125 | c ------------ |
|---|
| 126 | |
|---|
| 127 | sza0 = acos(PRMU0) ! in radians |
|---|
| 128 | c print*,'Angle Zenithal =',sza0,' PFRAC=',PFRAC |
|---|
| 129 | |
|---|
| 130 | nsza0=1 |
|---|
| 131 | do nsza=1,nszave |
|---|
| 132 | if (solza(nsza).le.sza0) then |
|---|
| 133 | nsza0 = nsza+1 |
|---|
| 134 | endif |
|---|
| 135 | enddo |
|---|
| 136 | |
|---|
| 137 | if ((nsza0.ne.1).and.(nsza0.ne.nszave+1)) then |
|---|
| 138 | factsza = (sza0-solza(nsza0-1))/(solza(nsza0)-solza(nsza0-1)) |
|---|
| 139 | endif |
|---|
| 140 | |
|---|
| 141 | c Pressure levels |
|---|
| 142 | c --------------- |
|---|
| 143 | |
|---|
| 144 | do j=1,klev+1 |
|---|
| 145 | nl0 = 2 |
|---|
| 146 | do i=1,nlve-1 |
|---|
| 147 | if (altve(i).le.pz(j)) then |
|---|
| 148 | nl0 = i+1 |
|---|
| 149 | endif |
|---|
| 150 | enddo |
|---|
| 151 | |
|---|
| 152 | factflux = (min(pz(j),altve(nlve)) |
|---|
| 153 | . -altve(nl0-1)) |
|---|
| 154 | . /(altve(nl0)-altve(nl0-1)) |
|---|
| 155 | |
|---|
| 156 | ! FLUXES |
|---|
| 157 | |
|---|
| 158 | ZFSNET(j) = 0. |
|---|
| 159 | if ((nsza0.ne.1).and.(nsza0.ne.nszave+1)) then |
|---|
| 160 | ZFSNET(j) = factflux * factsza *zsnet(nl0,nsza0) |
|---|
| 161 | . + factflux *(1.-factsza)*zsnet(nl0,nsza0-1) |
|---|
| 162 | . + (1.-factflux)* factsza *zsnet(nl0-1,nsza0) |
|---|
| 163 | . + (1.-factflux)*(1.-factsza)*zsnet(nl0-1,nsza0-1) |
|---|
| 164 | else if (nsza0.eq.1) then |
|---|
| 165 | ZFSNET(j) = factflux *zsnet(nl0,1) |
|---|
| 166 | . + (1.-factflux)*zsnet(nl0-1,1) |
|---|
| 167 | endif |
|---|
| 168 | ZFSNET(j) = ZFSNET(j)*PFRAC |
|---|
| 169 | |
|---|
| 170 | ! HEATING RATES |
|---|
| 171 | |
|---|
| 172 | if (j.ne.klev+1) then |
|---|
| 173 | PHEAT(j) = 0. |
|---|
| 174 | |
|---|
| 175 | if ((nsza0.ne.1).and.(nsza0.ne.nszave+1)) then |
|---|
| 176 | PHEAT(j) = factflux * factsza *zheat(nl0,nsza0) |
|---|
| 177 | . + factflux *(1.-factsza)*zheat(nl0,nsza0-1) |
|---|
| 178 | . + (1.-factflux)* factsza *zheat(nl0-1,nsza0) |
|---|
| 179 | . + (1.-factflux)*(1.-factsza)*zheat(nl0-1,nsza0-1) |
|---|
| 180 | else if (nsza0.eq.1) then |
|---|
| 181 | PHEAT(j) = factflux *zheat(nl0,1) |
|---|
| 182 | . + (1.-factflux)*zheat(nl0-1,1) |
|---|
| 183 | endif |
|---|
| 184 | PHEAT(j) = PHEAT(j)*PFRAC |
|---|
| 185 | endif |
|---|
| 186 | |
|---|
| 187 | enddo |
|---|
| 188 | |
|---|
| 189 | PTOPSW = ZFSNET(klev+1) |
|---|
| 190 | PSOLSW = ZFSNET(1) |
|---|
| 191 | |
|---|
| 192 | c Heating rates |
|---|
| 193 | c ------------- |
|---|
| 194 | c Conversion from W/m2 to K/s: |
|---|
| 195 | c heat(K/s) = d(fluxnet) (W/m2) |
|---|
| 196 | c *g (m/s2) |
|---|
| 197 | c /(-dp) (epaisseur couche, en Pa=kg/m/s2) |
|---|
| 198 | c /cp (J/kg/K) |
|---|
| 199 | |
|---|
| 200 | do j=1,klev |
|---|
| 201 | ! ADAPTATION GCM POUR CP(T) |
|---|
| 202 | PHEAT(j) = PHEAT(j) |
|---|
| 203 | . *RG/cpdet(pt(j)) / ((PPB(j)-PPB(j+1))*1.e5) |
|---|
| 204 | enddo |
|---|
| 205 | |
|---|
| 206 | return |
|---|
| 207 | end |
|---|
| 208 | |
|---|