/[lmdze]/trunk/Sources/phylmd/Radlwsw/lwbv.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Radlwsw/lwbv.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 155 by guez, Wed Jul 8 17:03:45 2015 UTC
# Line 1  Line 1 
1  SUBROUTINE lwbv(klim, pdp, pdt0, pemis, ppmb, ptl, ptave, pabcu, pfluc, &  module lwbv_m
2      pbint, pbsui, pcts, pcntrb)  
   USE dimens_m  
   USE dimphy  
   USE suphec_m  
   USE raddim  
   USE raddimlw  
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! PURPOSE.  contains
6    ! --------  
7    ! TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE    SUBROUTINE lwbv(klim, pdt0, pemis, ppmb, ptl, ptave, pabcu, pfluc, &
8    ! VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY         pbint, pbsui, pcts, pcntrb)
9    ! SAVING      USE dimens_m
10        USE dimphy
11    ! METHOD.      use lwv_m, only: lwv
12    ! -------      USE suphec_m
13        USE raddim
14    ! 1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE      USE raddimlw
15    ! GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.  
16    ! 2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-      ! PURPOSE.
17    ! TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE      ! --------
18    ! BOUNDARIES.      ! TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
19    ! 3. COMPUTES THE CLEAR-SKY COOLING RATES.      ! VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
20        ! SAVING
21    ! REFERENCE.  
22    ! ----------      ! METHOD.
23        ! -------
24    ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND  
25    ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS      ! 1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
26        ! GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
27    ! AUTHOR.      ! 2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
28    ! -------      ! TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
29    ! JEAN-JACQUES MORCRETTE  *ECMWF*      ! BOUNDARIES.
30        ! 3. COMPUTES THE CLEAR-SKY COOLING RATES.
31    ! MODIFICATIONS.  
32    ! --------------      ! REFERENCE.
33    ! ORIGINAL : 89-07-14      ! ----------
34    ! MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE  
35    ! MEMORY)      ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
36    ! -----------------------------------------------------------------------      ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
37    ! * ARGUMENTS:  
38    INTEGER klim      ! AUTHOR.
39        ! -------
40    DOUBLE PRECISION pdp(kdlon, kflev)      ! JEAN-JACQUES MORCRETTE  *ECMWF*
41    DOUBLE PRECISION pdt0(kdlon)  
42    DOUBLE PRECISION pemis(kdlon)      ! MODIFICATIONS.
43    DOUBLE PRECISION ppmb(kdlon, kflev+1)      ! --------------
44    DOUBLE PRECISION ptl(kdlon, kflev+1)      ! ORIGINAL : 89-07-14
45    DOUBLE PRECISION ptave(kdlon, kflev)      ! MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE
46        ! MEMORY)
47    DOUBLE PRECISION pfluc(kdlon, 2, kflev+1)      ! -----------------------------------------------------------------------
48        ! * ARGUMENTS:
49    DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1)      INTEGER klim
50    DOUBLE PRECISION pbint(kdlon, kflev+1)  
51    DOUBLE PRECISION pbsui(kdlon)      DOUBLE PRECISION pdt0(kdlon)
52    DOUBLE PRECISION pcts(kdlon, kflev)      DOUBLE PRECISION pemis(kdlon)
53    DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1)      DOUBLE PRECISION ppmb(kdlon, kflev+1)
54        DOUBLE PRECISION ptl(kdlon, kflev+1)
55    ! -------------------------------------------------------------------------      DOUBLE PRECISION ptave(kdlon, kflev)
56    
57    ! * LOCAL VARIABLES:      DOUBLE PRECISION pfluc(kdlon, 2, kflev+1)
58    DOUBLE PRECISION zb(kdlon, ninter, kflev+1)  
59    DOUBLE PRECISION zbsur(kdlon, ninter)      DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1)
60    DOUBLE PRECISION zbtop(kdlon, ninter)      DOUBLE PRECISION pbint(kdlon, kflev+1)
61    DOUBLE PRECISION zdbsl(kdlon, ninter, kflev*2)      DOUBLE PRECISION pbsui(kdlon)
62    DOUBLE PRECISION zga(kdlon, 8, 2, kflev)      DOUBLE PRECISION pcts(kdlon, kflev)
63    DOUBLE PRECISION zgb(kdlon, 8, 2, kflev)      DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1)
64    DOUBLE PRECISION zgasur(kdlon, 8, 2)  
65    DOUBLE PRECISION zgbsur(kdlon, 8, 2)      ! -------------------------------------------------------------------------
66    DOUBLE PRECISION zgatop(kdlon, 8, 2)  
67    DOUBLE PRECISION zgbtop(kdlon, 8, 2)      ! * LOCAL VARIABLES:
68        DOUBLE PRECISION zb(kdlon, ninter, kflev+1)
69    INTEGER nuaer, ntraer      DOUBLE PRECISION zbsur(kdlon, ninter)
70    ! ------------------------------------------------------------------      DOUBLE PRECISION zbtop(kdlon, ninter)
71    ! * COMPUTES PLANCK FUNCTIONS:      DOUBLE PRECISION zdbsl(kdlon, ninter, kflev*2)
72    CALL lwb(pdt0, ptave, ptl, zb, pbint, pbsui, zbsur, zbtop, zdbsl, zga, zgb, &      DOUBLE PRECISION zga(kdlon, 8, 2, kflev)
73      zgasur, zgbsur, zgatop, zgbtop)      DOUBLE PRECISION zgb(kdlon, 8, 2, kflev)
74    ! ------------------------------------------------------------------      DOUBLE PRECISION zgasur(kdlon, 8, 2)
75    ! * PERFORMS THE VERTICAL INTEGRATION:      DOUBLE PRECISION zgbsur(kdlon, 8, 2)
76    nuaer = nua      DOUBLE PRECISION zgatop(kdlon, 8, 2)
77    ntraer = ntra      DOUBLE PRECISION zgbtop(kdlon, 8, 2)
78    CALL lwv(nuaer, ntraer, klim, pabcu, zb, pbint, pbsui, zbsur, zbtop, zdbsl, &  
79      pemis, ppmb, ptave, zga, zgb, zgasur, zgbsur, zgatop, zgbtop, pcntrb, &      INTEGER nuaer, ntraer
80      pcts, pfluc)      ! ------------------------------------------------------------------
81    ! ------------------------------------------------------------------      ! * COMPUTES PLANCK FUNCTIONS:
82    RETURN      CALL lwb(pdt0, ptave, ptl, zb, pbint, pbsui, zbsur, zbtop, zdbsl, zga, zgb, &
83  END SUBROUTINE lwbv           zgasur, zgbsur, zgatop, zgbtop)
84        ! ------------------------------------------------------------------
85        ! * PERFORMS THE VERTICAL INTEGRATION:
86        nuaer = nua
87        ntraer = ntra
88        CALL lwv(nuaer, ntraer, klim, pabcu, zb, pbint, pbsui, zbsur, zbtop, &
89             zdbsl, pemis, ppmb, zga, zgb, zgasur, zgbsur, zgatop, zgbtop, pcntrb, &
90             pcts, pfluc)
91    
92      END SUBROUTINE lwbv
93    
94    end module lwbv_m
Legend:
Removed from v.134  
changed lines
  Added in v.155
  ViewVC Help
Powered by ViewVC 1.1.21