source: trunk/LMDZ.VENUS/libf/phyvenus/lw_venus_ve.F @ 955

Last change on this file since 955 was 953, checked in by slebonnois, 12 years ago

SL: optimisation pour le parallèle suite à tests Venus / petite correction appels routines secondaires dans Venus et Titan

File size: 3.4 KB
RevLine 
[3]1      SUBROUTINE LW_venus_ve(
2     S              PPB, pt, psi, deltapsi,
3     S              PCOOL,
4     S              PTOPLW,PSOLLW,PSOLLWDN,
5     S              ZFLNET)
6     
[101]7      use dimphy
[3]8      IMPLICIT none
9
10#include "dimensions.h"
11#include "YOMCST.h"
12C
13C     ------------------------------------------------------------------
14C
15C     PURPOSE.
16C     --------
17C
18c     This routine uses the NER matrix
[953]19c     (computed for a given cell and temp profile in radlwsw)
[3]20c     to compute cooling rates and radiative fluxes.
21c
22C     AUTHOR.
23C     -------
24C        Sebastien Lebonnois
25C
26C     MODIFICATIONS.
27C     --------------
28C        ORIGINAL : 27/07/2005
29C        version multimatrice (topographie, sommet nuages): 20/12/2006
30C     ------------------------------------------------------------------
31C
32C* ARGUMENTS:
33C
34c inputs
35
[892]36      REAL    PPB(klev+1)  ! inter-couches PRESSURE (bar)
37      REAL    pt(klev)     ! mid-layer temperature
38      real    psi(0:klev+1,0:klev+1)      ! NER in W/m**2
39      real    deltapsi(0:klev+1,0:klev+1) ! D NER / DT in W/m**2/K
[3]40C
41c output
42
[892]43      REAL   PCOOL(klev) ! LONGWAVE COOLING (K/VENUSDAY) within each layer
[3]44      REAL   PTOPLW       ! LONGWAVE FLUX AT T.O.A. (net, + vers le haut)
45      REAL   PSOLLW       ! LONGWAVE FLUX AT SURFACE (net, + vers le haut)
46      REAL   PSOLLWDN     ! LONGWAVE FLUX AT SURFACE (down, + vers le bas)
[892]47      REAL   ZFLNET(klev+1) ! net thermal flux at ppb levels (+ vers le haut)
[3]48
49C
50C* LOCAL VARIABLES:
51C
52      real    dureejour
53      parameter (dureejour=10.087e6)
54     
55      integer i,j,p
[892]56      real   zlnet(klev+1)    ! net thermal flux (W/m**2)
57      real   dzlnet(0:klev)   ! Radiative budget (W/m**2)
58      real   pdp(klev)        ! epaisseur de la couche en pression (Pa)
[3]59
60c --------------------------
61c Calculation of the fluxes
62c --------------------------
63
64c flux aux intercouches:
65c zlnet(i+1) est le flux net traversant le plafond de la couche i (+ vers le haut)
[892]66      do p=0,klev ! numero de la couche
[3]67        zlnet(p+1) = 0.0
[892]68        do j=p+1,klev+1
[3]69         do i=0,p
70           zlnet(p+1) = zlnet(p+1)+ psi(i,j)
71         enddo
72        enddo
73      enddo
74
75c flux net au sol, + vers le haut:
76      PSOLLW = zlnet(1)
77c flux vers le bas au sol, + vers le bas:
78      PSOLLWDN = 0.0
[892]79      do i=1,klev+1
[3]80        PSOLLWDN = PSOLLWDN+max(psi(i,0),0.0)
81      enddo
82
83c dfluxnet = radiative budget (W m-2)
[892]84      do p=0,klev ! numero de la couche
[3]85        dzlnet(p) = 0.0
[892]86        do j=0,klev+1
[3]87           dzlnet(p) = dzlnet(p)+psi(p,j)
88        enddo
89      enddo
90     
91c --------------------------------------
92c Interpolation in the GCM vertical grid
93c --------------------------------------
94
95c Flux net
96c --------
97     
[892]98      do j=1,klev+1
[3]99        ZFLNET(j) =  zlnet(j)
100      enddo
[892]101      PTOPLW   = ZFLNET(klev+1)
[3]102     
103c Heating rates
104c -------------
105
106c  cool (K/s) = dfluxnet (W/m2)    ! positif quand nrj sort de la couche
107c              *g        (m/s2)
108c              /(-dp)  (epaisseur couche, en Pa=kg/m/s2)
109c              /cp  (J/kg/K)
110     
[892]111      do j=1,klev
[3]112        pdp(j)=(PPB(j)-PPB(j+1))*1.e5
113      enddo
114
115c calcul direct OU calcul par schema implicit
[808]116      if (1.eq.1) then
[892]117        do j=1,klev
[3]118! ADAPTATION GCM POUR CP(T)
119         PCOOL(j) = dzlnet(j) *RG/cpdet(pt(j)) / pdp(j)
120        enddo
121      else
[892]122        call lwi(klev,dzlnet,deltapsi,pdp,pt,PCOOL)
[3]123      endif
124c     print*,dzlnet
125c     print*,pdp
126c     print*,PCOOL
127
[892]128      do j=1,klev
[3]129        PCOOL(j) = PCOOL(j)*dureejour ! K/Venusday
130      enddo
131
132      return
133      end
134
Note: See TracBrowser for help on using the repository browser.