source: trunk/LMDZ.VENUS/libf/phyvenus/sw_venus_ve_1Dglobave.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.4 KB
Line 
1      SUBROUTINE SW_venus_ve_1Dglobave( 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   zheatave(nlve-1)        ! for testing mean net solar flux
62      real   zsolnet(nlve)           ! for testing mean net solar flux
63      character*22 nullchar
64      real   deltasza
65      real   sza0,factflux,alt
66      logical firstcall
67      data    firstcall/.true./
68      save   solza,zsnet,altve,zheat,zheatave,zsolnet
69      save   firstcall
70     
71c ------------------------
72c Loading the files
73c ------------------------
74
75      if (firstcall) then
76
77! FLUXES (W/m2)
78
79       open(11,file='solar_fluxes_GCM.dat')
80       read(11,*) nullchar
81       read(11,*) nullchar
82       read(11,*) nullchar
83       read(11,*) nullchar
84     
85       do nsza=1,nszave
86        read(11,*) nullchar
87        read(11,*) solza(nsza)
88        read(11,*) nullchar
89        read(11,*) nullchar
90        do j=1,nlve
91           read(11,'(4(2x,F12.5))')
92     .          altve(j),zsdn,zsup,zsnet(j,nsza)
93        enddo
94       enddo
95
96       close(11)
97
98! HEATING RATES (W/m2)
99
100       open(12,file='solar_budgets_GCM.dat')
101       read(12,*) nullchar
102       read(12,*) nullchar
103       read(12,*) nullchar
104       read(12,*) nullchar
105     
106       do nsza=1,nszave
107        read(12,*) nullchar
108        read(12,*) solza(nsza)
109        read(12,*) nullchar
110        read(12,*) nullchar
111        do j=1,nlve-1
112           read(12,'(2(2x,F12.5))')
113     .          alt,zheat(j,nsza)
114        enddo
115       enddo
116
117       close(12)
118
119       firstcall=.false.
120      endif
121
122c ----------- TEST ------------
123c      Moyenne planetaire
124c -----------------------------
125      zheatave(:)=0.
126      zsolnet(:)=0.
127     
128      do j=1,nlve-1
129        deltasza=solza(1)+(solza(2)-solza(1))/2.  ! deja en radian
130        zheatave(j) = zheat(j,1)*deltasza*deltasza/16.
131        do nsza=2,nszave-1
132         deltasza=(solza(nsza)-solza(nsza-1))/2.
133     .           +(solza(nsza+1)-solza(nsza))/2.  ! deja en radian
134         zheatave(j) = zheatave(j)+zheat(j,nsza)*0.5*deltasza*
135     .             sin(solza(nsza))
136        enddo
137      enddo
138      do j=1,nlve
139        deltasza=solza(1)+(solza(2)-solza(1))/2.  ! deja en radian
140        zsolnet(j) = zsnet(j,1)*deltasza*deltasza/16.
141        do nsza=2,nszave
142         deltasza=(solza(nsza)-solza(nsza-1))/2.
143     .           +(solza(nsza+1)-solza(nsza))/2.  ! deja en radian
144         zsolnet(j) = zsolnet(j)+zsnet(j,nsza)*0.5*deltasza*
145     .             sin(solza(nsza))
146        enddo
147      enddo
148c      stop
149c -----------------------------
150c --------  FIN TEST ----------
151
152c --------------------------------------
153c Interpolation in the GCM vertical grid
154c --------------------------------------
155
156c Pressure levels
157c ---------------
158
159      do j=1,klev+1
160        nl0 = 2
161        do i=1,nlve-1
162           if (altve(i).le.pz(j)) then
163                nl0 = i+1
164           endif
165        enddo
166       
167        factflux = (min(pz(j),altve(nlve))
168     .                          -altve(nl0-1))
169     .            /(altve(nl0)-altve(nl0-1))
170
171! FLUXES
172
173        ZFSNET(j) =  factflux   *zsolnet(nl0)
174     .           + (1.-factflux)*zsolnet(nl0-1)
175
176! HEATING RATES
177
178        if (j.ne.klev+1) then
179          PHEAT(j) =  factflux   *zheatave(nl0)
180     .            + (1.-factflux)*zheatave(nl0-1)
181        endif
182
183      enddo
184
185      PTOPSW = ZFSNET(klev+1)
186      PSOLSW = ZFSNET(1)
187     
188c Heating rates
189c -------------
190c Conversion from W/m2 to K/s:
191c   heat(K/s) = d(fluxnet)  (W/m2)
192c              *g           (m/s2)
193c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
194c              /cp  (J/kg/K)
195
196      do j=1,klev
197! ADAPTATION GCM POUR CP(T)
198        PHEAT(j) = PHEAT(j)
199     .            *RG/cpdet(pt(j)) / ((PPB(j)-PPB(j+1))*1.e5)
200      enddo
201
202      return
203      end
204
Note: See TracBrowser for help on using the repository browser.