| [1310] | 1 | subroutine blendrad(nlon, nlev, pplay, heat, |
|---|
| 2 | & cool, pdtnirco2,zdtnlte, dtsw,dtlw ) |
|---|
| 3 | c |
|---|
| 4 | c Combine radiative tendencies. LTE contributions (heat and cool) |
|---|
| 5 | c have been calculated for the first NLAYLTE layers, zdtnirco2 and |
|---|
| 6 | c zdtnlte have been calculated for all nlev layers (but zdtnlte may |
|---|
| 7 | c be zero low down). cool is phased out in favour of zdtnlte with |
|---|
| 8 | c height; heat is also phased out to remove possible spurious heating |
|---|
| 9 | c at low pressures. The pressure at which the transition occurs and |
|---|
| 10 | c the scale over which this happens are set in the nlteparams.h file. |
|---|
| 11 | c Above layer NLAYLTE the tendency is purely the sum of NLTE contributions. |
|---|
| 12 | c (Note : nlaylte is calculated by "nlthermeq" and stored in common "yomlw.h") |
|---|
| 13 | c Stephen Lewis 6/2000 FF |
|---|
| 14 | |
|---|
| 15 | use dimphy |
|---|
| 16 | implicit none |
|---|
| 17 | c#include "dimradmars.h" |
|---|
| 18 | #include "nlteparams.h" |
|---|
| 19 | c#include "yomlw.h" |
|---|
| 20 | #include "YOMCST.h" |
|---|
| 21 | |
|---|
| 22 | c Input: |
|---|
| 23 | integer nlon, nlev |
|---|
| 24 | real pplay(nlon, nlev) |
|---|
| 25 | real cool(nlon, nlev) |
|---|
| 26 | real heat(nlon, nlev) |
|---|
| 27 | real pdtnirco2(nlon, nlev) |
|---|
| 28 | real zdtnlte(nlon, nlev) |
|---|
| 29 | c |
|---|
| 30 | c Output: |
|---|
| 31 | c real dtrad(nlon, nlev) |
|---|
| 32 | real dtlw(nlon, nlev) |
|---|
| 33 | real dtsw(nlon, nlev) |
|---|
| 34 | c |
|---|
| 35 | c Local: |
|---|
| 36 | integer l, ig |
|---|
| 37 | real alpha, alpha2 |
|---|
| 38 | real, parameter :: p_lowup = 10.e2 |
|---|
| 39 | |
|---|
| 40 | c |
|---|
| 41 | c This is split into two loops to minimize number of calculations, |
|---|
| 42 | c but for vector machines it may be faster to perform one big |
|---|
| 43 | c loop from 1 to nlev and remove the second loop. |
|---|
| 44 | c |
|---|
| 45 | |
|---|
| 46 | c print*, '--- NLAYTE value is: ---' |
|---|
| 47 | c print*, nlaylte |
|---|
| 48 | |
|---|
| 49 | c Loop over layers for which heat/lw have been calculated. |
|---|
| 50 | do l = 1,nlaylte !defini dans nlthermeq |
|---|
| 51 | do ig = 1, nlon |
|---|
| 52 | c alpha is actually 0.5*(1+tanh((z-ztrans)/zw)) |
|---|
| 53 | c written here in a simpler form, with z=-ln(p) and zwi=2/zw |
|---|
| 54 | alpha = 1./(1.+(pplay(ig,l)/ptrans)**zwi) |
|---|
| 55 | alpha2 = 1./(1.+(pplay(ig,l)/p_lowup)**zwi) |
|---|
| 56 | |
|---|
| 57 | c This formula is used in the Martian routines |
|---|
| 58 | c dtrad(ig,l) = (1.-alpha)*(heat(ig,l)+cool(ig,l)) |
|---|
| 59 | c & + pdtnirco2(ig,l) + alpha*zdtnlte(ig,l) |
|---|
| 60 | |
|---|
| 61 | dtlw(ig,l) = (1.-alpha)*(-cool(ig,l)) |
|---|
| 62 | & + alpha*zdtnlte(ig,l) |
|---|
| 63 | dtsw(ig,l) = (1-alpha2)*(heat(ig,l)) |
|---|
| 64 | & + alpha2*pdtnirco2(ig,l) |
|---|
| 65 | |
|---|
| 66 | enddo |
|---|
| 67 | enddo |
|---|
| 68 | |
|---|
| 69 | c |
|---|
| 70 | c Faster loop over any remaining layers. |
|---|
| 71 | do l = nlaylte+1, nlev |
|---|
| 72 | do ig = 1, nlon |
|---|
| 73 | |
|---|
| 74 | c dtrad(ig,l) = pdtnirco2(ig,l) + zdtnlte(ig,l) |
|---|
| 75 | |
|---|
| 76 | dtlw(ig,l) = zdtnlte(ig,l) |
|---|
| 77 | dtsw(ig,l) = pdtnirco2(ig,l) |
|---|
| 78 | enddo |
|---|
| 79 | enddo |
|---|
| 80 | |
|---|
| 81 | return |
|---|
| 82 | end |
|---|
