source: trunk/LMDZ.TITAN.old/libf/phytitan/radlwsw.F @ 3303

Last change on this file since 3303 was 1543, checked in by emillour, 9 years ago

All models: Further adaptations to keep up with changes in LMDZ5 concerning
physics/dynamics separation:

  • dyn3d:
  • adapted gcm.F so that all physics initializations are now done in iniphysiq.
  • dyn3dpar:
  • adapted gcm.F so that all physics initializations are now done in iniphysiq.
  • updated calfis_p.F to follow up with changes.
  • copied over updated "bands.F90" from LMDZ5.
  • dynphy_lonlat:
  • calfis_p.F90, mod_interface_dyn_phys.F90, follow up of changes in phy_common/mod_* routines
  • phy_common:
  • added "geometry_mod.F90" to store information about the grid (replaces phy*/comgeomphy.F90) and give variables friendlier names: rlond => longitude , rlatd => latitude, airephy => cell_area, cuphy => dx , cvphy => dy
  • added "physics_distribution_mod.F90"
  • updated "mod_grid_phy_lmdz.F90", "mod_phys_lmdz_mpi_data.F90", "mod_phys_lmdz_para.F90", "mod_phys_lmdz_mpi_transfert.F90", "mod_grid_phy_lmdz.F90", "mod_phys_lmdz_omp_data.F90", "mod_phys_lmdz_omp_transfert.F90", "write_field_phy.F90" and "ioipsl_getin_p_mod.F90" to LMDZ5 versions.
  • phy[venus/titan/mars/std]:
  • removed "init_phys_lmdz.F90", "comgeomphy.F90"; adapted routines to use geometry_mod (longitude, latitude, cell_area, etc.)

EM
File size: 6.2 KB
Line 
1      SUBROUTINE radlwsw(dist, rmu0, fract, zzlev,
2     .                  paprs, pplay,tsol, pt, nq, nmicro, pq,qaer)
3c     
4c======================================================================
5c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
6c Objet: interface entre le modele et les rayonnements
7c Arguments:
8c dist-----input-R- distance astronomique terre-soleil
9c rmu0-----input-R- cosinus de l'angle zenithal
10c fract----input-R- duree d'ensoleillement normalisee
11c falbe----input-R- surface albedo
12c zzlev----input-R- altitudes des inter-couches (m)
13c paprs----input-R- pression a inter-couche (Pa)
14c pplay----input-R- pression au milieu de couche (Pa)
15c tsol-----input-R- temperature du sol (en K)
16c t--------input-R- temperature (K)
17c nq-------input-R- nombre de traceurs
18c nmicro---input-R- nombre de traceurs microphysiques
19c pq-------input-R- traceurs (rapports de melange)
20c heat-----output-R- echauffement atmospherique (visible) (K/s)
21c cool-----output-R- refroidissement dans l'IR (K/s)
22c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
23c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
24c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
25c solsw----output-R- flux solaire net a la surface (+ vers le bas)
26c sollw----output-R- ray. IR net a la surface (+ vers le bas)
27c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
28c lwnet____output-R- flux IR net (+ vers le haut)
29c swnet____output-R- flux solaire net (+ vers le bas)
30c
31     
32c   S. Lebonnois    05/2008
33c  VERSION TITAN
34
35c======================================================================
36      use dimphy
37      USE phys_state_var_mod, only: falbe,heat,cool,radsol,
38     .      topsw,toplw,solsw,sollw,sollwdown,lwnet,swnet,
39     .      lwup,lwdn,swup,swdn
40      USE write_field_phy
41       IMPLICIT none
42#include "YOMCST.h"
43#include "clesphys.h"
44c
45c ARGUMENTS
46      INTEGER nq,nmicro
47      real rmu0(klon), fract(klon), dist
48c
49      real zzlev(klon,klev+1),paprs(klon,klev+1), pplay(klon,klev)
50      real tsol(klon)
51      real pt(klon,klev)
52      real pq(klon,klev,nq)
53      REAL qaer(klon,klev,nq)
54c
55c LOCAL VARIABLES
56      integer i,k,l,iq
57      real zp(klon,klev+1),zt(klon,klev+1),zz(klon,klev+1)
58      real zq(klon,klev,nq)
59      real zheatc(klon,klev), zcoolc(klon,klev)
60      real zheatp(klon,klev), zcoolp(klon,klev)
61      REAL zswupc(klon,klev+1),zlwupc(klon,klev+1)
62      REAL zswupp(klon,klev+1),zlwupp(klon,klev+1)
63      REAL zswdnc(klon,klev+1),zlwdnc(klon,klev+1)
64      REAL zswdnp(klon,klev+1),zlwdnp(klon,klev+1)
65      REAL zsollwdownc(klon),zsollwdownp(klon)
66      INTEGER icld
67
68
69c =======================================
70c INITIALISATIONS
71c =======================================
72
73c   passage au pressions en bar avec indice 1 au sommet.
74             do l=2,klev+1
75                do i=1,klon
76                   zp(i,l)=paprs(i,klev+2-l)*1.e-5
77                enddo
78             enddo
79             do i=1,klon
80                zp(i,1)=zp(i,2)*.001
81             enddo
82
83c     call WriteField_phy('radlwsw_zp',zp,klev+1)
84
85c =======================================
86c   altitudes (m) avec indice 1 en haut
87             do l=1,klev+1
88                do i=1,klon
89                   zz(i,l)=zzlev(i,klev+2-l)
90                enddo
91             enddo
92
93c   temperatures avec indice 1 en haut
94             do l=1,klev
95                do i=1,klon
96                   zt(i,l)=pt(i,klev+1-l)
97                enddo
98             enddo
99             do i=1,klon
100                zt(i,klev+1)=tsol(i)
101             enddo
102
103c  traceurs avec indice 1 en haut
104             do l=1,klev
105                do i=1,klon
106                 do iq=1,nq
107                   zq(i,l,iq)=pq(i,klev+1-l,iq)
108                 enddo
109                enddo
110             enddo
111
112c =======================================
113c CALCUL DES TAU V+IR  (dans des common...)
114c =======================================
115
116      print*,'On calcule les opacites'
117
118         CALL radtitan(zp,nq,nmicro,zq,qaer)
119
120c CALCUL DU SW
121c =======================================
122
123      print*,'On calcule le rayonnement SW'
124
125       IF (clouds.eq.1) THEN
126         ICLD = 1   ! colonne avec nuages
127         CALL heating(dist,rmu0,fract,falbe,zheatc,zswupc,zswdnc,icld)
128       ELSE
129         zheatc  = 0.
130         zswupc = 0.
131         zswdnc = 0.
132       ENDIF
133       ICLD = 0   ! colonne sans nuages
134       CALL heating(dist,rmu0,fract,falbe,zheatp,zswupp,zswdnp,icld)
135
136c inversion de l'axe vertical
137       do l=1,klev
138         do i=1,klon
139           heat(i,l)=zheatc(i,klev+1-l)*xnuf +
140     &               zheatp(i,klev+1-l)*(1.-xnuf)
141         enddo
142       enddo
143       do l=1,klev+1
144         do i=1,klon
145           swup(i,l) =zswupc(i,klev+2-l)*xnuf +
146     &                zswupp(i,klev+2-l)*(1.-xnuf)
147           swdn(i,l) =zswdnc(i,klev+2-l)*xnuf +
148     &                zswdnp(i,klev+2-l)*(1.-xnuf)
149           swnet(i,l)=swdn(i,l)-swup(i,l)
150         enddo
151       enddo
152
153      solsw = swnet(:,1)
154      topsw = swnet(:,klev+1)
155
156c =======================================
157c CALCUL DU LW
158c =======================================
159
160      print*,'On calcule le rayonnement LW'
161
162       IF (clouds.eq.1) THEN
163         ICLD = 1
164         CALL cooling(klon,klev+1,zp,zt,zz,zcoolc,zlwupc,zlwdnc,
165     &   zsollwdownc,icld)
166       ELSE
167         zcoolc      = 0.
168         zlwupc      = 0.
169         zlwdnc      = 0.
170         zsollwdownc = 0.
171       ENDIF
172       ICLD = 0
173       CALL cooling(klon,klev+1,zp,zt,zz,zcoolp,zlwupp,zlwdnp,
174     & zsollwdownp,icld)
175
176c inversion de l'axe vertical
177       do l=1,klev
178         do i=1,klon
179           cool(i,l)=zcoolc(i,klev+1-l)*xnuf +
180     &               zcoolp(i,klev+1-l)*(1.-xnuf)
181         enddo
182       enddo
183       do l=1,klev+1
184         do i=1,klon
185           lwup(i,l) =zlwupc(i,klev+2-l)*xnuf +
186     &                zlwupp(i,klev+2-l)*(1.-xnuf)
187           lwdn(i,l) =zlwdnc(i,klev+2-l)*xnuf +
188     &                zlwdnp(i,klev+2-l)*(1.-xnuf)
189           lwnet(i,l)=lwup(i,l)-lwdn(i,l)
190         enddo
191       enddo
192   
193       do i=1,klon
194         sollwdown(i)=zsollwdownc(i)*xnuf +
195     &                zsollwdownp(i)*(1.-xnuf)
196       enddo
197
198      sollw  = -lwnet(:,1)
199      toplw  = lwnet(:,klev+1)
200      radsol = solsw+sollw
201     
202      RETURN
203      END
Note: See TracBrowser for help on using the repository browser.