source: trunk/LMDZ.VENUS/libf/phyvenus/radlwsw.multimat @ 402

Last change on this file since 402 was 101, checked in by slebonnois, 14 years ago

SL: modifications pour arriver a compiler le gcm VENUS !
Ca marche !
A noter: modifs de makelmdz
File size: 6.2 KB
Line 
1!
2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/radlwsw.F,v 1.2 2004/10/27 10:14:46 lmdzadmin Exp $
3!
4      SUBROUTINE radlwsw(dist, rmu0, fract,
5     .                  paprs, pplay,tsol, t,
6     .                  heat,cool,radsol,
7     .                  topsw,toplw,solsw,sollw,
8     .                  sollwdown,
9     .                  lwnet, swnet)
10c     
11c======================================================================
12c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
13c Objet: interface entre le modele et les rayonnements
14c Arguments:
15c dist-----input-R- distance astronomique terre-soleil
16c rmu0-----input-R- cosinus de l'angle zenithal
17c fract----input-R- duree d'ensoleillement normalisee
18c solaire--input-R- constante solaire (W/m**2) (dans clesphys.h)
19c paprs----input-R- pression a inter-couche (Pa)
20c pplay----input-R- pression au milieu de couche (Pa)
21c tsol-----input-R- temperature du sol (en K)
22c t--------input-R- temperature (K)
23c heat-----output-R- echauffement atmospherique (visible) (K/jour)
24c cool-----output-R- refroidissement dans l'IR (K/jour)
25c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
26c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
27c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
28c solsw----output-R- flux solaire net a la surface (+ vers le bas)
29c sollw----output-R- ray. IR net a la surface (+ vers le bas)
30c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
31c lwnet____output-R- flux IR net (+ vers le haut)
32c swnet____output-R- flux solaire net (+ vers le bas)
33c
34     
35c MODIFS pour multimatrices ksi SPECIFIQUE VENUS
36c   S. Lebonnois    20/12/2006
37c   corrections     13/07/2007
38
39c======================================================================
40      use dimphy
41      USE comgeomphy
42      IMPLICIT none
43#include "dimensions.h"
44#include "YOMCST.h"
45#include "clesphys.h"
46#include "comcstVE.h"
47c
48      real rmu0(klon), fract(klon), dist
49c
50      real paprs(klon,klev+1), pplay(klon,klev)
51      real tsol(klon)
52      real t(klon,klev)
53      real heat(klon,klev), cool(klon,klev)
54      real radsol(klon), topsw(klon), toplw(klon)
55      real solsw(klon), sollw(klon)
56      real sollwdown(klon)
57      REAL swnet(klon,kflev+1),lwnet(klon,kflev+1)
58c
59      INTEGER k, kk, i, j, nb_gr
60c
61      REAL   PPB(kflev+1)
62c
63      REAL   zfract, zrmu0
64c
65      REAL   zheat(kflev), zcool(kflev)
66      REAL   ZFSNET(KFLEV+1),ZFLNET(KFLEV+1)
67      REAL   ztopsw, ztoplw
68      REAL   zsolsw, zsollw
69cIM BEG
70      REAL   zsollwdown
71cIM END
72      real   ksive(0:kflev+1,0:kflev+1,nnuve,nbmat)  ! ksi matrixes in Vincent's file
73      real    psimap(0:kflev+1,0:kflev+1,klon)
74      real    deltapsimap(0:kflev+1,0:kflev+1,klon)
75      real    psi(0:kflev+1,0:kflev+1)
76      real    deltapsi(0:kflev+1,0:kflev+1)
77      real    latdeg,ztop(klon) ! in km
78      real    pt0(klon,0:kflev+1)
79
80      save    ksive,ztop
81
82      logical firstcall
83      data    firstcall/.true./
84      save    firstcall
85     
86c-------------------------------------------
87      nb_gr = klon
88c-------------------------------------------
89c  Initialisations
90c-----------------
91
92      if (firstcall) then
93        call load_ksi(ksive)
94
95c ---------- ztop --------------
96        DO i = 1, klon
97             ztop(i) = 70.
98        ENDDO !i
99
100c ztop: d'apres fit à figure 16 du papier Zavosa et al (tmp) traitant des
101c       donnees Venera
102c       DO i = 1, klon
103c         latdeg = abs(rlatd(i))
104c         if (latdeg.lt.15) then
105c            ztop(i) = 70.
106c         elseif (latdeg.lt.50) then
107c            ztop(i) = 63.95+6*cos((latdeg-15)*RPI/2./50.)
108c         else
109c            ztop(i) = min(63.95+6*cos((latdeg-15)*RPI/2./50.),
110c    .                     63.95-5.9*sin((latdeg-60)*RPI/2/30))
111c         endif
112c       print*,'lat(',i,')=',latdeg,'  ztop=',ztop(i)
113c       ENDDO !i
114c ---------- ztop --------------
115
116      endif ! firstcall
117
118      DO i = 1, klon
119          pt0(i,0)  = tsol(i)
120          DO k = 1, klev
121            pt0(i,k) = t(i,k)
122          ENDDO
123          pt0(i,kflev+1) = 0.
124      ENDDO !i
125
126      call load_psi(paprs(:,1),ztop,ksive,pt0,psimap,deltapsimap)
127
128      DO k = 1, klev
129      DO i = 1, klon
130         heat(i,k)=0.
131         cool(i,k)=0.
132      ENDDO
133      ENDDO
134c
135c+++++++ BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
136      DO 99999 j = 1, nb_gr
137 
138       DO k = 1, klev
139        zheat(k) = 0.0
140        zcool(k) = 0.0
141       ENDDO
142       DO k = 1, klev+1
143        ZFLNET(k) = 0.0
144        ZFSNET(k) = 0.0
145       ENDDO
146       ztopsw = 0.0
147       ztoplw = 0.0
148       zsolsw = 0.0
149       zsollw = 0.0
150       zsollwdown = 0.0
151     
152         zfract = fract(j)
153         zrmu0 = rmu0(j)
154 
155      DO k = 1, kflev+1
156         PPB(k) = paprs(j,k)/1.e5
157      ENDDO
158 
159      DO k = 0,kflev+1
160      DO i = 0,kflev+1
161        psi(i,k) = psimap(i,k,j)
162        deltapsi(i,k) = deltapsimap(i,k,j)
163      ENDDO
164      ENDDO
165       
166c======================================================================
167c LW call
168c---------
169      CALL LW_venus_ve(
170     .        PPB,t(j,:),psi,deltapsi,
171     .        zcool,
172     .        ztoplw,zsollw,
173     .        zsollwdown,ZFLNET)
174
175c---------
176c SW call
177c---------
178      CALL SW_venus_dc(zrmu0, zfract,
179     S        PPB,t(j,:),
180     S        zheat,
181     S        ztopsw,zsolsw,ZFSNET)
182     
183c======================================================================
184         radsol(j) = zsolsw - zsollw  ! + vers bas
185         topsw(j) = ztopsw            ! + vers bas
186         toplw(j) = ztoplw            ! + vers haut
187         solsw(j) = zsolsw            ! + vers bas
188         sollw(j) = -zsollw           ! + vers bas
189         sollwdown(j) = zsollwdown    ! + vers bas
190
191         DO k = 1, kflev+1
192         lwnet  (j,k)   = ZFLNET(k)
193         swnet  (j,k)   = ZFSNET(k)
194         ENDDO
195
196      DO k = 1, kflev
197         heat (j,k) = zheat(k)
198         cool (j,k) = zcool(k)
199      ENDDO
200c
20199999 CONTINUE
202c+++++++ FIN BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
203
204c tests
205
206c     j = klon/2
207c     j = 1
208c     print*,'mu0=',rmu0(j)
209c     print*,'   net flux vis   HEAT(K/day)'
210c     do k=1,kflev
211c     print*,k,ZFSNET(k),heat(j,k)*8.56548e-3
212c     enddo
213c     print*,'   net flux IR    COOL(K/day)'
214c     do k=1,kflev
215c     print*,k,ZFLNET(k),cool(j,k)*8.56548e-3
216c     enddo
217
218      firstcall = .false.
219      RETURN
220      END
221
Note: See TracBrowser for help on using the repository browser.