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