source: trunk/LMDZ.MARS/libf/phymars/callradite_mod.F @ 2437

Last change on this file since 2437 was 2417, checked in by emillour, 5 years ago

Mars GCM:
Add a new scheme to handle the dust and its radiative impact. Triggered using
a new flag dustscaling_mode=2 (dustscaling_mod=0: no rescaling at all, and
dustscaling_mode=1: full rescaling using tauscaling, GCMv5.3 style). Rescaling
is then only done on the radiative impact (see dust_scaling_mod.F90) of dust.
Moreover the scaling factor "dust_rad_adjust" is evaluated using the target dust
scenario opacity for the next sol and left to evolve linearly until then to not
impose the diurnal evolution of dust.
In practice, main changes or additions in the code are:

  • renamed flag "tauscaling_mode" as "dustscaling_mode"
  • moved parameter "t_scenario_sol" to "dust_param_mod"
  • adapted "compute_dustscaling" routine in "dust_scaling_mod"
  • added module "dust_rad_adjust_mod"
  • 2D fields "dust_rad_adjust_prev" and "dust_rad_adjust_next" required to compute coefficient "dust_rad_adjust" need to be stored in (re)startfi files

EM

File size: 22.3 KB
RevLine 
[1711]1      MODULE callradite_mod
2
3      IMPLICIT NONE
4
5      CONTAINS
6
[38]7      SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
8     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
[1974]9     $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,
[2415]10     $     fluxtop_sw,tau_pref_scenario,tau_pref_gcm,
[2417]11     &     tau,aerosol,dsodust,tauscaling,dust_rad_adjust,
[2199]12     $     taucloudtes,rdust,rice,nuice,co2ice,rstormdust,rtopdust,
[2246]13     $     totstormfract,clearatm,dsords,dsotop,alpha_hmons,nohmons,
[1974]14     $     clearsky,totcloudfrac)
[38]15
[1918]16      use aeropacity_mod, only: aeropacity
[1969]17      use updatereffrad_mod, only: updatereffrad
[1047]18      use dimradmars_mod, only: ndomainsz, nflev, nsun, nir
[1246]19      use dimradmars_mod, only: naerkind, name_iaer,
20     &            iaer_dust_conrath,iaer_dust_doubleq,
[1974]21     &            iaer_dust_submicron,iaer_h2o_ice,
[2199]22     &            iaer_stormdust_doubleq,iaer_topdust_doubleq
[1047]23      use yomlw_h, only: gcp, nlaylte
[1524]24      use comcstfi_h, only: g,cpp
25      use time_phylmdz_mod, only: daysec
[1983]26      use lwmain_mod, only: lwmain
27      use swmain_mod, only: swmain
[2409]28      use dust_param_mod, only: doubleq, active, submicron
[1047]29      IMPLICIT NONE
[38]30c=======================================================================
31c   subject:
32c   --------
33c   Subroutine designed to call the main canonic
34c   radiative transfer subroutine "lwmain" et "swmain"
35c   to compute radiative heating and cooling rate and
36c   radiative fluxes to the surface.
37c
38c   These calculations are only valid on the part of the atmosphere
[2246]39c   where Local Thermal Equilibrium (LTE) is verified. In practice
40c   the calculations are only performed for the first "nlaylte"
[38]41c   parameters (nlaylte is calculated by subroutine "nlthermeq"
[1047]42c   and stored in module "yomlw_h").
[38]43c
44c   The purpose of this subroutine is to:
45c      1) Make some initial calculation at first call
46c      2) Split the calculation in several sub-grid
47c        ("sub-domain") to save memory and
48c        be able run on a workstation at high resolution
[1047]49c        The sub-grid size is defined in dimradmars_mod
[38]50c      3) Compute the 3D scattering parameters depending on the
51c        size distribution of the different tracers (added by JBM)
52c      4) call "lwmain" and "swmain"
53c
54c
55c   authors:   
56c   ------
57c   Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
58c
59c
60c   3D scattering scheme user's guide (J.-B. Madeleine)
61c   ---------------------------------
62c
63c   This routine has been modified to take into account 3D, time
64c   dependent scattering properties of the aerosols.
65c---- The look-up tables that contain the scattering parameters
66c   of a given tracer, for different sizes, are read by SUAER.F90.
67c   The names of the corresponding ASCII files have to be set in
68c   this subroutine (file_id variable), and files must be in the
[1918]69c   directory specified in datafile_mod. Please make sure that the
[38]70c   ASCII files are correctly written, and that the range
71c   of particle sizes is consistent with what you would expect.
72c---- SUAER.F90 is in charge of reading the ASCII files and averaging
73c   the scattering parameters in each GCM channel, using the three last
74c   equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
75c---- These look-up tables, loaded during the firstcall, are then
76c   constantly used by the subroutine "aeroptproperties.F" to compute,
77c   online, the 3D scattering parameters, based on the size distribution
78c   (reffrad and nueffrad) of the different tracers, in each grid box.
79c   These 3D size distributions are loaded by the "updatereffrad.F"
80c   subroutine. A log-normal distribution is then assumed in
81c   "aeroptproperties.F", along with a Gauss-Legendre integration.
82c---- The optical depth at the visible reference wavelength (set in
83c   SUAER.F90, after the file_id variable) is then computed by
84c   the subroutine "aeropacity.F", by using the size and spatial
85c   distribution of the corresponding tracer. This connection has to
86c   be implemented in "aeropacity.F" when adding a new tracer. To do so,
87c   one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
88c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
89c   "gVIS3d" (same in the infrared) are finally used by lwmain.F and
90c   swmain.F to solve the radiative transfer equation.
91c
92c   changes:
93c   -------
94c
95c   > SRL 7/2000
96c   
97c   This version has been modified to only calculate radiative tendencies
[1047]98c   over layers 1..NFLEV (set in dimradmars_mod).  Returns zero for higher
[38]99c   layers, if any.
[1266]100c   In other routines, nlayer -> nflev.
[38]101c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
102c
103c   > J.-B. Madeleine 10W12
104c   This version uses the variable's splitting, which can be usefull
105c     when performing very high resolution simulation like LES.
106c
107c   ----------
108c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
[1047]109c   set in dimradmars_mod
[38]110c   Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
[1047]111c   set in dimradmars_mod
[38]112c
113c   input:
114c   -----
115c   icount                counter of call to subroutine physic by gcm
116c   ngrid                 number of gridpoint of horizontal grid
117c   nlayer                Number of layer
118c   nq                    Number of tracer
119c   ls                    Solar longitude (Ls) , radian
120c   zday                  Date (time since Ls=0, in martian days)
121c   pq(ngrid,nlayer,nq)   Advected fields
122c
123c   albedo (ngrid,2)      hemispheric surface albedo
124c                         albedo (i,1) : mean albedo for solar band#1
125c                                        (see below)
126c                         albedo (i,2) : mean albedo for solar band#2
127c                                        (see below)
128c   emis                  Thermal IR surface emissivity (no unit)
[1047]129c   mu0(ngrid)           cos of solar zenith angle
[38]130c                           (=1 when sun at zenith)
131c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
132c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
133c   pt(ngrid,nlayer)       atmospheric temperature in each layer (K)
134c   tsurf(ngrid)           surface temperature (K)
[1047]135c   fract(ngrid)         day fraction of the time interval
[38]136c                          =1 during the full day ; =0 during the night
137c   declin                 latitude of subsolar point
138c   dist_sol               sun-Mars distance (AU)
139c   igout                  coordinate of analysed point for debugging
140c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
141c   nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
142
143c
144c  output:
145c  -------
146c dtlw (ngrid,nlayer)       longwave (IR) heating rate (K/s)
147c dtsw(ngrid,nlayer)        shortwave (Solar) heating rate (K/s)
148c fluxsurf_lw(ngrid)        surface downward flux tota LW (thermal IR) (W.m-2)
149c fluxsurf_sw(ngrid,1)      surface downward flux SW for solar band#1 (W.m-2)
150c fluxsurf_sw(ngrid,2)      surface downward flux SW for solar band#2 (W.m-2)
151c
152c fluxtop_lw(ngrid)         outgoing upward flux tota LW (thermal IR) (W.m-2)
153c fluxtop_sw(ngrid,1)       outgoing upward flux SW for solar band#1 (W.m-2)
154c fluxtop_sw(ngrid,2)       outgoing upward flux SW for solar band#2 (W.m-2)
155
156c   tau          Column total visible dust optical depth at each point
157c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
158c                         at reference wavelength "longrefvis" set
[1047]159c                         in dimradmars_h , in each layer, for one of
[38]160c                         the "naerkind" kind of aerosol optical
161c                         properties.
162c=======================================================================
163c
164c    Declarations :
165c    -------------
166c
[1974]167      include "callkeys.h"
[38]168
169c-----------------------------------------------------------------------
170c    Input/Output
171c    ------------
[1047]172      INTEGER,INTENT(IN) :: icount       
173      INTEGER,INTENT(IN) :: ngrid,nlayer,nq
174      INTEGER,INTENT(IN) :: igout
[38]175
[1047]176      REAL,INTENT(IN) :: pq(ngrid,nlayer,nq)
[1974]177      REAL,INTENT(INOUT) :: tauscaling(ngrid) ! Conversion factor for
[358]178                               ! qdust and Ndust
[2417]179      REAL,INTENT(OUT) :: dust_rad_adjust(ngrid) ! Radiative adjustment
180                          ! factor for dust
[1047]181      REAL,INTENT(IN) :: albedo(ngrid,2),emis(ngrid)
182      REAL,INTENT(IN) :: ls,zday
[38]183
[1047]184      REAL,INTENT(IN) :: pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
185      REAL,INTENT(IN) :: pt(ngrid,nlayer)
186      REAL,INTENT(IN) :: tsurf(ngrid)
187      REAL,INTENT(IN) :: dist_sol,mu0(ngrid),fract(ngrid)
188      REAL,INTENT(OUT) :: dtlw(ngrid,nlayer),dtsw(ngrid,nlayer)
189      REAL,INTENT(OUT) :: fluxsurf_lw(ngrid), fluxtop_lw(ngrid)
190      REAL,INTENT(OUT) :: fluxsurf_sw(ngrid,2), fluxtop_sw(ngrid,2)
[2415]191      REAL,INTENT(OUT) :: tau_pref_scenario(ngrid) ! prescribed dust column
192                          ! visible opacity at odpref from scenario
193      REAL,INTENT(OUT) :: tau_pref_gcm(ngrid) ! computed dust column
194                          ! visible opacity at odpref in the GCM
195      REAL,INTENT(OUT) :: tau(ngrid,naerkind)
[1047]196      REAL,INTENT(OUT) :: taucloudtes(ngrid)! Cloud opacity at infrared
[520]197                               !   reference wavelength using
198                               !   Qabs instead of Qext
199                               !   (direct comparison with TES)
[1047]200      REAL,INTENT(OUT) :: aerosol(ngrid,nlayer,naerkind)
[2252]201      REAL,INTENT(INOUT) :: dsodust(ngrid,nlayer)
[1047]202      REAL,INTENT(OUT) :: rdust(ngrid,nlayer)  ! Dust geometric mean radius (m)
203      REAL,INTENT(OUT) :: rice(ngrid,nlayer)   ! Ice geometric mean radius (m)
204      REAL,INTENT(OUT) :: nuice(ngrid,nlayer)  ! Estimated effective variance
205      REAL,INTENT(IN) :: co2ice(ngrid)           ! co2 ice surface layer (kg.m-2)
[1974]206
207c     rocket dust storm
208      LOGICAL,INTENT(IN) :: clearatm ! true for background dust
209      REAL,INTENT(IN) :: totstormfract(ngrid) ! dust storm mesh fraction
210      REAL,INTENT(OUT) :: rstormdust(ngrid,nlayer)  ! Storm dust geometric mean radius (m)
[2415]211      REAL,INTENT(OUT) :: dsords(ngrid,nlayer) ! density scaled opacity for rocket dust storm dust
[2246]212     
[2199]213c     entrainment by slope wind
214      LOGICAL, INTENT(IN) :: nohmons ! true for background dust
215      REAL, INTENT(IN) :: alpha_hmons(ngrid) ! sub-grid scale topography mesh fraction
216      REAL,INTENT(OUT) :: rtopdust(ngrid,nlayer)  ! Topdust geometric mean radius (m)
[2415]217      REAL,INTENT(OUT) :: dsotop(ngrid,nlayer) ! density scaled opacity for topmons dust
[2246]218     
[1711]219c     sub-grid scale water ice clouds
[1974]220      LOGICAL,INTENT(IN) :: clearsky
221      REAL,INTENT(IN) :: totcloudfrac(ngrid)
[353]222
[38]223c
224c    Local variables :
225c    -----------------
226
227      INTEGER j,l,ig,n,ich
228      INTEGER aer_count,iaer
229      INTEGER jd,ig0,nd
230
231      real  cste_mars ! solar constant on Mars (Wm-2)
[1047]232      REAL ptlev(ngrid,nlayer+1)
[38]233
[1774]234      INTEGER :: ndomain
[38]235
236c     Thermal IR net radiative budget (W m-2)
237
238      real znetrad(ndomainsz,nflev)
239
240      real zfluxd_sw(ndomainsz,nflev+1,2)
241      real zfluxu_sw(ndomainsz,nflev+1,2)
242
243      REAL zplev(ndomainsz,nflev+1)
244      REAL zztlev(ndomainsz,nflev+1)
245      REAL zplay(ndomainsz,nflev)
246      REAL zt(ndomainsz,nflev)
247      REAL zaerosol(ndomainsz,nflev,naerkind)
248      REAL zalbedo(ndomainsz,2)
249      REAL zdp(ndomainsz,nflev)
250      REAL zdt0(ndomainsz)
251
252      REAL zzdtlw(ndomainsz,nflev)
253      REAL zzdtsw(ndomainsz,nflev)
254      REAL zzflux(ndomainsz,6)
255      real zrmuz
256
257      REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
258      REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
259      REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
260
261      REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
262      REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
263      REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
264
265c     Aerosol size distribution
266      REAL :: reffrad(ngrid,nlayer,naerkind)
267      REAL :: nueffrad(ngrid,nlayer,naerkind)
268c     Aerosol optical properties
[1047]269      REAL :: QVISsQREF3d(ngrid,nlayer,nsun,naerkind)
270      REAL :: omegaVIS3d(ngrid,nlayer,nsun,naerkind)
271      REAL :: gVIS3d(ngrid,nlayer,nsun,naerkind)
[38]272
[1047]273      REAL :: QIRsQREF3d(ngrid,nlayer,nir,naerkind)
274      REAL :: omegaIR3d(ngrid,nlayer,nir,naerkind)
275      REAL :: gIR3d(ngrid,nlayer,nir,naerkind)
[38]276
[1047]277      REAL :: QREFvis3d(ngrid,nlayer,naerkind)
[2246]278      ! QREFvis3d : Extinction efficiency at the VISible reference wavelength
[1047]279      REAL :: QREFir3d(ngrid,nlayer,naerkind)
[2246]280      ! QREFir3d : Extinction efficiency at the InfraRed reference wavelength
[38]281
[1047]282      REAL :: omegaREFvis3d(ngrid,nlayer,naerkind)
283      REAL :: omegaREFir3d(ngrid,nlayer,naerkind)
[38]284
285c   local saved variables
286c   ---------------------
287
288      real zco2   ! volume fraction of CO2 in Mars atmosphere
289      DATA zco2/0.95/
290      SAVE zco2
291
292      LOGICAL firstcall
293      DATA firstcall/.true./
294      SAVE firstcall
295
296c----------------------------------------------------------------------
297
298c     Initialisation
299c     --------------
300
[1776]301! compute ndomain
302! AS: moved out of firstcall to allow nesting+evoluting domain
303! ------------------------------------------------------------
304      ndomain= (ngrid-1) / ndomainsz + 1
305
[38]306      IF (firstcall) THEN
307
[1776]308         write(*,*) 'Splitting radiative calculations: ',
309     $              ' ngrid,ndomainsz,ndomain',
310     $                ngrid,ndomainsz,ndomain
311
[38]312c        Assign a number to the different scatterers
313c        -------------------------------------------
314
315         iaer_dust_conrath=0
316         iaer_dust_doubleq=0
317         iaer_dust_submicron=0
318         iaer_h2o_ice=0
[1974]319         iaer_stormdust_doubleq=0
[2199]320         iaer_topdust_doubleq=0
[38]321
322         aer_count=0
323         if (.NOT.active) then
324           do iaer=1,naerkind
325             if (name_iaer(iaer).eq."dust_conrath") then
326               iaer_dust_conrath = iaer
327               aer_count = aer_count + 1
328             endif
329           enddo
330         endif
331         if (doubleq.AND.active) then
332           do iaer=1,naerkind
333             if (name_iaer(iaer).eq."dust_doubleq") then
334               iaer_dust_doubleq = iaer
335               aer_count = aer_count + 1
336             endif
337           enddo
338         endif
339         if (submicron.AND.active) then
340           do iaer=1,naerkind
341             if (name_iaer(iaer).eq."dust_submicron") then
342               iaer_dust_submicron = iaer
343               aer_count = aer_count + 1
344             endif
345           enddo
346         endif
347         if (water.AND.activice) then
348           do iaer=1,naerkind
349             if (name_iaer(iaer).eq."h2o_ice") then
350               iaer_h2o_ice = iaer
351               aer_count = aer_count + 1
352             endif
353           enddo
354         endif
[1974]355         if (rdstorm.AND.active) then
356           do iaer=1,naerkind
357             if (name_iaer(iaer).eq."stormdust_doubleq") then
358               iaer_stormdust_doubleq = iaer
359               aer_count = aer_count + 1
360             endif
361           enddo
362         end if
[2199]363         if (slpwind.AND.active) then
364           do iaer=1,naerkind
365             if (name_iaer(iaer).eq."topdust_doubleq") then
366               iaer_topdust_doubleq = iaer
367               aer_count = aer_count + 1
368             endif
369           enddo
370         end if
[38]371
372c        Check that we identified all tracers:
373         if (aer_count.ne.naerkind) then
374           write(*,*) "callradite: found only ",aer_count," scatterers"
375           write(*,*) "               expected ",naerkind
376           write(*,*) "please make sure that the number of"
[1047]377           write(*,*) "scatterers in scatterers.h, the names"
[38]378           write(*,*) "in callradite.F, and the flags in"
379           write(*,*) "callphys.def are all consistent!"
380           do iaer=1,naerkind
381             write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
382           enddo
[2398]383           call abort_physic("callradite","incoherent scatterers",1)
[38]384         else
385           write(*,*) "callradite: found all scatterers, namely:"
386           do iaer=1,naerkind
387             write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
388           enddo
389         endif
390c        -------------------------------------------
391
392         gcp = g/cpp
393
394c        Loading the optical properties in external look-up tables:
395         CALL SUAER
[1047]396!         CALL SULW ! this step is now done in ini_yomlw_h
[38]397
[1047]398         if (ngrid .EQ. 1) then
[38]399           if (ndomainsz .NE. 1) then
400             print*
401             print*,'ATTENTION !!!'
402             print*,'pour tourner en 1D, '
[1047]403             print*,'fixer ndomainsz=1 dans phymars/dimradmars_h'
[38]404             print*
405             call exit(1)
406           endif
407         endif
[1774]408
[38]409         firstcall=.false.
410      END IF
411
412c     Computing aerosol optical properties and opacity
413c     ------------------------------------------------
414
415c     Updating aerosol size distributions:
416      CALL updatereffrad(ngrid,nlayer,
[2199]417     &                rdust,rstormdust,rtopdust,rice,nuice,
[38]418     &                reffrad,nueffrad,
[740]419     &                pq,tauscaling,tau,pplay)
[38]420
421c     Computing 3D scattering parameters:
422      CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
423     &                      QVISsQREF3d,omegaVIS3d,gVIS3d,
424     &                      QIRsQREF3d,omegaIR3d,gIR3d,
425     &                      QREFvis3d,QREFir3d,
426     &                      omegaREFvis3d,omegaREFir3d)
427
428c     Computing aerosol optical depth in each layer:
429      CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
[2417]430     &    pq,tauscaling,dust_rad_adjust,tau_pref_scenario,tau_pref_gcm,
[2415]431     &    tau,taucloudtes,aerosol,dsodust,reffrad,
[1974]432     &    QREFvis3d,QREFir3d,omegaREFir3d,
[2246]433     &    totstormfract,clearatm,dsords,dsotop,
[2199]434     &    alpha_hmons,nohmons,
[1974]435     &    clearsky,totcloudfrac)
[38]436
437c     Starting loop on sub-domain
438c     ----------------------------
439
440      DO jd=1,ndomain
441        ig0=(jd-1)*ndomainsz
442        if (jd.eq.ndomain) then
[1047]443         nd=ngrid-ig0
[38]444        else
445         nd=ndomainsz
446        endif
447
448c       Spliting input variable in sub-domain input variables
449c       ---------------------------------------------------
450
451        do l=1,nlaylte
452         do ig = 1,nd
453           do iaer = 1, naerkind
454             do ich = 1, nsun
455               zQVISsQREF3d(ig,l,ich,iaer) =
456     &                           QVISsQREF3d(ig0+ig,l,ich,iaer)
457               zomegaVIS3d(ig,l,ich,iaer) =
458     &                           omegaVIS3d(ig0+ig,l,ich,iaer)
459               zgVIS3d(ig,l,ich,iaer) =
460     &                           gVIS3d(ig0+ig,l,ich,iaer)
461             enddo
462             do ich = 1, nir
463               zQIRsQREF3d(ig,l,ich,iaer) =
464     &                           QIRsQREF3d(ig0+ig,l,ich,iaer)
465               zomegaIR3d(ig,l,ich,iaer) =
466     &                           omegaIR3d(ig0+ig,l,ich,iaer)
467               zgIR3d(ig,l,ich,iaer) =
468     &                           gIR3d(ig0+ig,l,ich,iaer)
469             enddo
470           enddo
471         enddo
472        enddo
473
474        do l=1,nlaylte+1
475         do ig = 1,nd
476          zplev(ig,l) = pplev(ig0+ig,l)
477         enddo
478        enddo
479
480        do l=1,nlaylte
481         do ig = 1,nd
482          zplay(ig,l) = pplay(ig0+ig,l)
483          zt(ig,l) = pt(ig0+ig,l)
484c         Thickness of each layer (Pa) :
485          zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
486         enddo
487        enddo
488
489        do n=1,naerkind
490          do l=1,nlaylte
491            do ig=1,nd
492              zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
493            enddo
494          enddo
495        enddo
496
497        do j=1,2
498          do ig = 1,nd
499           zalbedo(ig,j) = albedo(ig0+ig,j)
500          enddo
501        enddo
502
503c       Intermediate  levels: (computing tlev)
504c       ---------------------------------------
505c       Extrapolation for the air temperature above the surface
506        DO ig=1,nd
507              zztlev(ig,1)=zt(ig,1)+
508     s        (zplev(ig,1)-zplay(ig,1))*
509     s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
510
511              zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
512        ENDDO
513
514        DO l=2,nlaylte
515         DO ig=1, nd
516               zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l))
517         ENDDO
518        ENDDO
519
520        DO ig=1, nd
521           zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
522        ENDDO
523
524
525c       Longwave ("lw") radiative transfer (= thermal infrared)
526c       -------------------------------------------------------
527        call lwmain (ig0,icount,nd,nflev
528     .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
529     .        ,zaerosol,zzdtlw
530     .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
531     .        ,znetrad
[353]532     &        ,zQIRsQREF3d,zomegaIR3d,zgIR3d
533     &        ,co2ice(ig0+1))
[38]534
535c       Shortwave ("sw") radiative transfer (= solar radiation)
536c       -------------------------------------------------------
537c          Mars solar constant (W m-2)
538c          1370 W.m-2 is the solar constant at 1 AU.
539           cste_mars=1370./(dist_sol*dist_sol)
540
541           call swmain ( nd, nflev,
542     S     cste_mars, zalbedo,
543     S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
544     S     zzdtsw, zfluxd_sw, zfluxu_sw,
545     &     zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
546
547c       ------------------------------------------------------------
548c       Un-spliting output variable from sub-domain input variables
549c       ------------------------------------------------------------
550
551        do l=1,nlaylte
552         do ig = 1,nd
553          dtlw(ig0+ig,l) = zzdtlw(ig,l)
554          dtsw(ig0+ig,l) = zzdtsw(ig,l)
555         enddo
556        enddo
557
558        do l=1,nlaylte+1
559         do ig = 1,nd
560          ptlev(ig0+ig,l) = zztlev(ig,l)
561         enddo
562        enddo
563
564        do ig = 1,nd
565          fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
566          fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
567          fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
568          fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
569        enddo
570
571      ENDDO         !   (boucle jd=1, ndomain)
572
573c     Zero tendencies for any remaining layers between nlaylte and nlayer
574      if (nlayer.gt.nlaylte) then
575         do l = nlaylte+1, nlayer
576            do ig = 1, ngrid
577               dtlw(ig, l) = 0.
578               dtsw(ig, l) = 0.
579            enddo
580         enddo
581      endif
582
583c     Output for debugging if lwrite=T
584c     --------------------------------
585c     Write all nlayer layers, even though only nlaylte layers may have
586c     non-zero tendencies.
587
588         IF(lwrite) THEN
589            PRINT*,'Diagnotique for the radiation'
590            PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
591            PRINT*,albedo(igout,1),emis(igout),mu0(igout),
592     s           fract(igout), fluxsurf_lw(igout),
593     $     fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
594            PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
595            PRINT*,'daysec',daysec
596            DO l=1,nlayer
597               PRINT*,pt(igout,l),ptlev(igout,l),
598     s         pplay(igout,l),pplev(igout,l),
599     s         dtsw(igout,l),dtlw(igout,l)
600            ENDDO
601         ENDIF
602
603
[1711]604      END SUBROUTINE callradite
605
606      END MODULE callradite_mod
Note: See TracBrowser for help on using the repository browser.