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