/[lmdze]/trunk/libf/phylmd/Radlwsw/lw.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/Radlwsw/lw.f90

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

trunk/libf/phylmd/Radlwsw/lw.f revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC trunk/libf/phylmd/Radlwsw/lw.f90 revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC
# Line 1  Line 1 
1  cIM ctes ds clesphys.h   SUBROUTINE LW(RCO2,RCH4,RN2O,RCFC11,RCFC12,  module lw_m
2        SUBROUTINE LW(  
3       .              PPMB, PDP,    IMPLICIT none
4       .              PPSOL,PDT0,PEMIS,  
5       .              PTL, PTAVE, PWV, POZON, PAER,  contains
6       .              PCLDLD,PCLDLU,  
7       .              PVIEW,    SUBROUTINE LW(PPMB, PDP, PPSOL, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, &
8       .              PCOLR, PCOLR0,         PCLDLD, PCLDLU, PVIEW, PCOLR, PCOLR0, PTOPLW, PSOLLW, PTOPLW0, PSOLLW0, &
9       .              PTOPLW,PSOLLW,PTOPLW0,PSOLLW0,         psollwdown, plwup, plwdn, plwup0, plwdn0)
10       .              psollwdown,  
11       .              plwup, plwdn, plwup0, plwdn0)      use LWU_m, only: LWU
12        use dimens_m      USE suphec_m, ONLY: md, rcpd, rday, rg, rmo3
13        use dimphy      USE raddim, ONLY: kdlon, kflev
14        use clesphys      USE raddimlw, ONLY: nua
15        use SUPHEC_M  
16        use raddim      ! Method.
17              use raddimlw  
18        IMPLICIT none      ! 1. Computes the pressure and temperature weighted amounts of
19  C      ! absorbers.
20  C-----------------------------------------------------------------------  
21  C     METHOD.      ! 2. Computes the planck functions on the interfaces and the
22  C     -------      ! gradient of planck functions in the layers.
23  C  
24  C          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF      ! 3. Performs the vertical integration distinguishing the con-
25  C     ABSORBERS.      ! tributions of the adjacent and distant layers and those from the
26  C          2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE      ! boundaries.
27  C     GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.  
28  C          3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-      ! 4. Computes the clear-sky downward and upward emissivities.
29  C     TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE  
30  C     BOUNDARIES.      ! 5. Introduces the effects of the clouds on the fluxes.
31  C          4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.  
32  C          5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES.      ! Reference: see radiation's part of the model's documentation and
33  C      ! ECMWF research department documentation of the IFS
34  C  
35  C     REFERENCE.      ! Author:
36  C     ----------      ! Jean-Jacques Morcrette *ECMWF*
37  C  
38  C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND      ! Original : 89-07-14
39  C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS  
40  C      DOUBLE PRECISION PCLDLD(KDLON, KFLEV) ! DOWNWARD EFFECTIVE CLOUD COVER
41  C     AUTHOR.      DOUBLE PRECISION PCLDLU(KDLON, KFLEV) ! UPWARD EFFECTIVE CLOUD COVER
42  C     -------      DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER PRESSURE THICKNESS (Pa)
43  C        JEAN-JACQUES MORCRETTE  *ECMWF*      DOUBLE PRECISION PDT0(KDLON) ! SURFACE TEMPERATURE DISCONTINUITY (K)
44  C      DOUBLE PRECISION PEMIS(KDLON) ! SURFACE EMISSIVITY
45  C     MODIFICATIONS.      DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF LEVEL PRESSURE (mb)
46  C     --------------      DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (Pa)
47  C        ORIGINAL : 89-07-14      DOUBLE PRECISION POZON(KDLON, KFLEV) ! O3 CONCENTRATION (kg/kg)
48  C-----------------------------------------------------------------------      DOUBLE PRECISION PTL(KDLON, KFLEV+1) ! HALF LEVEL TEMPERATURE (K)
49  cIM ctes ds clesphys.h      DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! OPTICAL THICKNESS OF THE AEROSOLS
50  c     REAL*8 RCO2   ! CO2 CONCENTRATION (IPCC:353.E-06* 44.011/28.97)      DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
51  c     REAL*8 RCH4   ! CH4 CONCENTRATION (IPCC: 1.72E-06* 16.043/28.97)      DOUBLE PRECISION PVIEW(KDLON) ! COSECANT OF VIEWING ANGLE
52  c     REAL*8 RN2O   ! N2O CONCENTRATION (IPCC: 310.E-09* 44.013/28.97)      DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (kg/kg)
53  c     REAL*8 RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12* 137.3686/28.97)  
54  c     REAL*8 RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12* 120.9140/28.97)      DOUBLE PRECISION PCOLR(KDLON, KFLEV) ! LONG-WAVE TENDENCY (K/day)
55        REAL*8 PCLDLD(KDLON,KFLEV)  ! DOWNWARD EFFECTIVE CLOUD COVER      DOUBLE PRECISION PCOLR0(KDLON, KFLEV) ! LONG-WAVE TENDENCY (K/day) clear-sky
56        REAL*8 PCLDLU(KDLON,KFLEV)  ! UPWARD EFFECTIVE CLOUD COVER      DOUBLE PRECISION PTOPLW(KDLON) ! LONGWAVE FLUX AT T.O.A.
57        REAL*8 PDP(KDLON,KFLEV)     ! LAYER PRESSURE THICKNESS (Pa)      DOUBLE PRECISION PSOLLW(KDLON) ! LONGWAVE FLUX AT SURFACE
58        REAL*8 PDT0(KDLON)          ! SURFACE TEMPERATURE DISCONTINUITY (K)      DOUBLE PRECISION PTOPLW0(KDLON) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
59        REAL*8 PEMIS(KDLON)         ! SURFACE EMISSIVITY      DOUBLE PRECISION PSOLLW0(KDLON) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
60        REAL*8 PPMB(KDLON,KFLEV+1)  ! HALF LEVEL PRESSURE (mb)      ! Rajout LF
61        REAL*8 PPSOL(KDLON)         ! SURFACE PRESSURE (Pa)      double precision psollwdown(kdlon) ! LONGWAVE downwards flux at surface
62        REAL*8 POZON(KDLON,KFLEV)   ! O3 CONCENTRATION (kg/kg)      !IM
63        REAL*8 PTL(KDLON,KFLEV+1)   ! HALF LEVEL TEMPERATURE (K)      DOUBLE PRECISION plwup(KDLON, KFLEV+1) ! LW up total sky
64        REAL*8 PAER(KDLON,KFLEV,5)  ! OPTICAL THICKNESS OF THE AEROSOLS      DOUBLE PRECISION plwup0(KDLON, KFLEV+1) ! LW up clear sky
65        REAL*8 PTAVE(KDLON,KFLEV)   ! LAYER TEMPERATURE (K)      DOUBLE PRECISION plwdn(KDLON, KFLEV+1) ! LW down total sky
66        REAL*8 PVIEW(KDLON)         ! COSECANT OF VIEWING ANGLE      DOUBLE PRECISION plwdn0(KDLON, KFLEV+1) ! LW down clear sky
67        REAL*8 PWV(KDLON,KFLEV)     ! SPECIFIC HUMIDITY (kg/kg)  
68  C      DOUBLE PRECISION ZABCU(KDLON, NUA, 3*KFLEV+1)
69        REAL*8 PCOLR(KDLON,KFLEV)   ! LONG-WAVE TENDENCY (K/day)      DOUBLE PRECISION ZOZ(KDLON, KFLEV)
70        REAL*8 PCOLR0(KDLON,KFLEV)  ! LONG-WAVE TENDENCY (K/day) clear-sky  
71        REAL*8 PTOPLW(KDLON)        ! LONGWAVE FLUX AT T.O.A.      DOUBLE PRECISION ZFLUX(KDLON, 2, KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down)
72        REAL*8 PSOLLW(KDLON)        ! LONGWAVE FLUX AT SURFACE      DOUBLE PRECISION ZFLUC(KDLON, 2, KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
73        REAL*8 PTOPLW0(KDLON)       ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)      DOUBLE PRECISION ZBINT(KDLON, KFLEV+1) ! Intermediate variable
74        REAL*8 PSOLLW0(KDLON)       ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)      DOUBLE PRECISION ZBSUI(KDLON) ! Intermediate variable
75  c Rajout LF      DOUBLE PRECISION ZCTS(KDLON, KFLEV) ! Intermediate variable
76        real*8 psollwdown(kdlon)    ! LONGWAVE downwards flux at surface      DOUBLE PRECISION ZCNTRB(KDLON, KFLEV+1, KFLEV+1) ! Intermediate variable
77  cIM      SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB
78        REAL*8 plwup(KDLON,KFLEV+1)  ! LW up total sky  
79        REAL*8 plwup0(KDLON,KFLEV+1) ! LW up clear sky      INTEGER ilim, i, k, kpl1
80        REAL*8 plwdn(KDLON,KFLEV+1)  ! LW down total sky  
81        REAL*8 plwdn0(KDLON,KFLEV+1) ! LW down clear sky      INTEGER, PARAMETER:: lw0pas = 1 ! Every lw0pas steps, clear-sky is done
82  C-------------------------------------------------------------------------      INTEGER, PARAMETER:: lwpas = 1 ! Every lwpas steps, cloudy-sky is done
83        REAL*8 ZABCU(KDLON,NUA,3*KFLEV+1)      ! In general, lw0pas and lwpas should be 1
84        REAL*8 ZOZ(KDLON,KFLEV)  
85  c      INTEGER:: itaplw0 = 0, itaplw = 0
86        REAL*8 ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down)  
87        REAL*8 ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES      ! ------------------------------------------------------------------
88        REAL*8 ZBINT(KDLON,KFLEV+1)            ! Intermediate variable  
89        REAL*8 ZBSUI(KDLON)                    ! Intermediate variable      IF (MOD(itaplw0, lw0pas) == 0) THEN
90        REAL*8 ZCTS(KDLON,KFLEV)               ! Intermediate variable         DO k = 1, KFLEV
91        REAL*8 ZCNTRB(KDLON,KFLEV+1,KFLEV+1)   ! Intermediate variable            DO i = 1, KDLON
92        SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB               ! convertir ozone de kg/kg en pa (modif MPL 100505)
93  c               ZOZ(i, k) = POZON(i, k)*PDP(i, k) * MD/RMO3
94        INTEGER ilim, i, k, kpl1            ENDDO
95  C         ENDDO
96        INTEGER lw0pas ! Every lw0pas steps, clear-sky is done         CALL LWU(PAER, PDP, PPMB, PPSOL, ZOZ, PTAVE, PVIEW, PWV, ZABCU)
97        PARAMETER (lw0pas=1)         CALL LWBV(ILIM, PDP, PDT0, PEMIS, PPMB, PTL, PTAVE, ZABCU, &
98        INTEGER lwpas  ! Every lwpas steps, cloudy-sky is done              ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB)
99        PARAMETER (lwpas=1)         itaplw0 = 0
100  c      ENDIF
101        INTEGER itaplw0, itaplw      itaplw0 = itaplw0 + 1
102        LOGICAL appel1er  
103        SAVE appel1er, itaplw0, itaplw      IF (MOD(itaplw, lwpas) == 0) THEN
104        DATA appel1er /.TRUE./         CALL LWC(ILIM, PCLDLD, PCLDLU, PEMIS, &
105        DATA itaplw0,itaplw /0,0/              ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB, &
106  C     ------------------------------------------------------------------              ZFLUX)
107        IF (appel1er) THEN         itaplw = 0
108           PRINT*, "LW clear-sky calling frequency: ", lw0pas      ENDIF
109           PRINT*, "LW cloudy-sky calling frequency: ", lwpas      itaplw = itaplw + 1
110           PRINT*, "   In general, they should be 1"  
111           appel1er=.FALSE.      DO k = 1, KFLEV
112        ENDIF         kpl1 = k+1
113  C         DO i = 1, KDLON
114        IF (MOD(itaplw0,lw0pas).EQ.0) THEN            PCOLR(i, k) = ZFLUX(i, 1, kpl1)+ZFLUX(i, 2, kpl1) &
115        DO k = 1, KFLEV  ! convertir ozone de kg/kg en pa/pa                 - ZFLUX(i, 1, k)- ZFLUX(i, 2, k)
116        DO i = 1, KDLON            PCOLR(i, k) = PCOLR(i, k) * RDAY*RG/RCPD / PDP(i, k)
117  c convertir ozone de kg/kg en pa (modif MPL 100505)            PCOLR0(i, k) = ZFLUC(i, 1, kpl1)+ZFLUC(i, 2, kpl1) &
118           ZOZ(i,k) = POZON(i,k)*PDP(i,k) * MD/RMO3                 - ZFLUC(i, 1, k)- ZFLUC(i, 2, k)
119  c        print *,'LW: ZOZ*10**6=',ZOZ(i,k)*1000000.            PCOLR0(i, k) = PCOLR0(i, k) * RDAY*RG/RCPD / PDP(i, k)
120        ENDDO         ENDDO
121        ENDDO      ENDDO
122  cIM ctes ds clesphys.h   CALL LWU(RCO2,RCH4, RN2O, RCFC11, RCFC12,      DO i = 1, KDLON
123        CALL LWU(         PSOLLW(i) = -ZFLUX(i, 1, 1)-ZFLUX(i, 2, 1)
124       S         PAER,PDP,PPMB,PPSOL,ZOZ,PTAVE,PVIEW,PWV,ZABCU)         PTOPLW(i) = ZFLUX(i, 1, KFLEV+1) + ZFLUX(i, 2, KFLEV+1)
125        CALL LWBV(ILIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,ZABCU,  
126       S          ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB)         PSOLLW0(i) = -ZFLUC(i, 1, 1)-ZFLUC(i, 2, 1)
127        itaplw0 = 0         PTOPLW0(i) = ZFLUC(i, 1, KFLEV+1) + ZFLUC(i, 2, KFLEV+1)
128        ENDIF         psollwdown(i) = -ZFLUX(i, 2, 1)
129        itaplw0 = itaplw0 + 1  
130  C         !IM attention aux signes !; LWtop >0, LWdn < 0
131        IF (MOD(itaplw,lwpas).EQ.0) THEN         DO k = 1, KFLEV+1
132        CALL LWC(ILIM,PCLDLD,PCLDLU,PEMIS,            plwup(i, k) = ZFLUX(i, 1, k)
133       S         ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB,            plwup0(i, k) = ZFLUC(i, 1, k)
134       S         ZFLUX)            plwdn(i, k) = ZFLUX(i, 2, k)
135        itaplw = 0            plwdn0(i, k) = ZFLUC(i, 2, k)
136        ENDIF         ENDDO
137        itaplw = itaplw + 1      ENDDO
138  C  
139        DO k = 1, KFLEV    END SUBROUTINE LW
140           kpl1 = k+1  
141           DO i = 1, KDLON  end module lw_m
             PCOLR(i,k) = ZFLUX(i,1,kpl1)+ZFLUX(i,2,kpl1)  
      .                 - ZFLUX(i,1,k)-   ZFLUX(i,2,k)  
             PCOLR(i,k) = PCOLR(i,k) * RDAY*RG/RCPD / PDP(i,k)  
             PCOLR0(i,k) = ZFLUC(i,1,kpl1)+ZFLUC(i,2,kpl1)  
      .                 - ZFLUC(i,1,k)-   ZFLUC(i,2,k)  
             PCOLR0(i,k) = PCOLR0(i,k) * RDAY*RG/RCPD / PDP(i,k)  
          ENDDO  
       ENDDO  
       DO i = 1, KDLON  
          PSOLLW(i) = -ZFLUX(i,1,1)-ZFLUX(i,2,1)  
          PTOPLW(i) = ZFLUX(i,1,KFLEV+1) + ZFLUX(i,2,KFLEV+1)  
 c  
          PSOLLW0(i) = -ZFLUC(i,1,1)-ZFLUC(i,2,1)  
          PTOPLW0(i) = ZFLUC(i,1,KFLEV+1) + ZFLUC(i,2,KFLEV+1)  
          psollwdown(i) = -ZFLUX(i,2,1)  
 c  
 cIM attention aux signes !; LWtop >0, LWdn < 0  
          DO k = 1, KFLEV+1  
            plwup(i,k) = ZFLUX(i,1,k)  
            plwup0(i,k) = ZFLUC(i,1,k)  
            plwdn(i,k) = ZFLUX(i,2,k)  
            plwdn0(i,k) = ZFLUC(i,2,k)  
          ENDDO  
       ENDDO  
 C     ------------------------------------------------------------------  
       RETURN  
       END  
Legend:
Removed from v.70  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.21