source: trunk/LMDZ.VENUS/libf/phyvenus/sw_venus_ve.F @ 1518

Last change on this file since 1518 was 1442, checked in by slebonnois, 10 years ago

SL: update of the Venus GCM, + corrections on routines used for newstart/start2archive for Titan and Venus, + some modifications on tools

File size: 5.6 KB
Line 
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"
12C
13C     ------------------------------------------------------------------
14C
15C     PURPOSE.
16C     --------
17C
18c      this routine loads and interpolates the shortwave radiation
19c     fluxes and heating rates computed from Vincent Eymet 3D MC code
20C
21C     AUTHOR.
22C     -------
23C        Sebastien Lebonnois
24C
25C     MODIFICATIONS.
26C     --------------
27C        ORIGINAL : 06/2014
28C     ------------------------------------------------------------------
29C
30C* ARGUMENTS:
31C
32c 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)
39C
40c 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
47C
48C* LOCAL VARIABLES:
49C
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     
69c ------------------------
70c Loading the files
71c ------------------------
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
120c --------------------------------------
121c Interpolation in the GCM vertical grid
122c --------------------------------------
123
124c Zenith angle
125c ------------
126     
127      sza0 = acos(PRMU0)  ! in radians
128c        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
141c Pressure levels
142c ---------------
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     
192c Heating rates
193c -------------
194c Conversion from W/m2 to K/s:
195c   heat(K/s) = d(fluxnet)  (W/m2)
196c              *g           (m/s2)
197c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
198c              /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
Note: See TracBrowser for help on using the repository browser.