Index: LMDZ5/trunk/libf/phylmd/rrtm/recmwf.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/rrtm/recmwf.F90	(revision 2120)
+++ 	(revision )
@@ -1,399 +1,0 @@
-!OPTIONS XOPT(NOEVAL)
-SUBROUTINE RECMWF (KST, KEND, KPROMA, KTDIA , KLEV,&
- & KMODE,&
- & PALBD , PALBP , PAPRS , PAPRSF , PCCO2 , PCLFR,&
- & PQO3  , PAER  , PDP   , PEMIS  , PMU0,&
- & PQ    , PQS   , PQIWP , PQLWP , PSLM   , PT    , PTS,&
- & PREF_LIQ, PREF_ICE,&
- & PEMTD , PEMTU , PTRSO,&
- & PTH   , PCTRSO, PCEMTR, PTRSOD,&
- & PLWFC, PLWFT, PSWFC, PSWFT, PSFSWDIR, PSFSWDIF,&
- & PFSDNN, PFSDNV,&  
- & PPIZA_DST,PCGA_DST,PTAUREL_DST,PFLUX,PFLUC,&
- & PFSDN ,PFSUP , PFSCDN , PFSCUP)
-
-!**** *RECMWF* - METEO-FRANCE RADIATION INTERFACE TO ECMWF RADIATION SCHEME
-
-!     PURPOSE.
-!     --------
-!           SIMPLE INTERFACE TO RADLSW (NO INTERPOLATION)
-
-!**   INTERFACE.
-!     ----------
-
-!     EXPLICIT ARGUMENTS :
-!        --------------------
-! KST    : START INDEX OF DATA IN KPROMA-LONG VECTOR
-! KEND   : END   INDEX OF DATA IN KPROMA-LONG VECTOR
-! KPROMA : VECTOR LENGTH
-! KTDIA  : INDEX OF TOP LEVEL FROM WHICH COMPUTATIONS ARE ACTIVE
-! KLEV   : NUMBER OF LEVELS
-! PAER   : (KPROMA,KLEV ,6)     ; OPTICAL THICKNESS OF THE AEROSOLS
-! PALBD  : (KPROMA,NSW)         ; DIFFUSE ALBEDO IN THE 2 SW INTERVALS
-! PALBP  : (KPROMA,NSW)         ; PARALLEL ALBEDO IN THE 2 SW INTERVALS
-! PAPRS  : (KPROMA,KLEV+1)      ; HALF LEVEL PRESSURE
-! PAPRSF : (KPROMA,KLEV )       ; FULL LEVEL PRESSURE
-! PCCO2  :                      ; CONCENTRATION IN CO2 (PA/PA)
-! PCLFR  : (KPROMA,KLEV )       ; CLOUD FRACTIONAL COVER
-! PQO3   : (KPROMA,KLEV )       ; OZONE MIXING RATIO (MASS)
-! PDP    : (KPROMA,KLEV)        ; LAYER PRESSURE THICKNESS
-! PEMIS  : (KPROMA)             ; SURFACE EMISSIVITY
-! PMU0   : (KPROMA)             ; SOLAR ANGLE
-! PQ     : (KPROMA,KLEV )       ; SPECIFIC HUMIDITY PA/PA
-! PQS    : (KPROMA,KLEV )       ; SATURATION SPECIFIC HUMIDITY PA/PA
-! PQIWP  : (KPROMA,KLEV )       ; ICE    WATER KG/KG
-! PQLWP  : (KPROMA,KLEV )       ; LIQUID WATER KG/KG
-! PSLM   : (KPROMA)             ; LAND-SEA MASK
-! PT     : (KPROMA,KLEV)        ; FULL LEVEL TEMPERATURE
-! PTS    : (KPROMA)             ; SURFACE TEMPERATURE
-! PPIZA_DST  : (KPROMA,KLEV,NSW); Single scattering albedo of dust 
-! PCGA_DST   : (KPROMA,KLEV,NSW); Assymetry factor for dust 
-! PTAUREL_DST: (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm
-! PREF_LIQ (KPROMA,KLEV)        ; Liquid droplet radius (um)
-! PREF_ICE (KPROMA,KLEV)        ; Ice crystal radius (um)
-
-!     ==== OUTPUTS ===
-! PEMTD (KPROMA,KLEV+1)         ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
-! PEMTU (KPROMA,KLEV+1)         ; TOTAL UPWARD   LONGWAVE EMISSIVITY
-! PTRSO (KPROMA,KLEV+1)         ; TOTAL SHORTWAVE TRANSMISSIVITY
-! PTH   (KPROMA,KLEV+1)         ; HALF LEVEL TEMPERATURE
-! PCTRSO(KPROMA,2)              ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
-! PCEMTR(KPROMA,2)              ; CLEAR-SKY NET LONGWAVE EMISSIVITY
-! PTRSOD(KPROMA)                ; TOTAL-SKY SURFACE SW TRANSMISSITY
-! PLWFC (KPROMA,2)              ; CLEAR-SKY LONGWAVE FLUXES
-! PLWFT (KPROMA,KLEV+1)         ; TOTAL-SKY LONGWAVE FLUXES
-! PSWFC (KPROMA,2)              ; CLEAR-SKY SHORTWAVE FLUXES
-! PSWFT (KPROMA,KLEV+1)         ; TOTAL-SKY SHORTWAVE FLUXES
-! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08)
-! PFLUX (KPROMA,2,KLEV+1)       ; LW total sky flux (1=up, 2=down)
-! PFLUC (KPROMA,2,KLEV+1)       ; LW clear sky flux (1=up, 2=down)
-! PFSDN(KPROMA,KLEV+1)          ; SW total sky flux down
-! PFSUP(KPROMA,KLEV+1)          ; SW total sky flux up
-! PFSCDN(KPROMA,KLEV+1)         ; SW clear sky flux down
-! PFSCUP(KPROMA,KLEV+1)         ; SW clear sky flux up
-
-
-!        IMPLICIT ARGUMENTS :   NONE
-!        --------------------
-
-!     METHOD.
-!     -------
-!     SEE DOCUMENTATION
-
-!     EXTERNALS.
-!     ----------
-
-!     REFERENCE.
-!     ----------
-!     ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-
-!     AUTHORS.
-!     --------
-!     ORIGINAL BY  B. RITTER   *ECMWF*        83-10-13
-!     REWRITING FOR IFS BY J.-J. MORCRETTE    94-11-15
-!     96-11: Ph. Dandin. Meteo-France
-!     REWRITING FOR DM  BY J.PH. PIEDELIEVRE   1998-07
-!     Duplication of RFMR to use present (cy25) ECMWF radiation scheme : Y. Bouteloup 09-2003
-!     Use of 6 aerosols & introduce NSW : F. Bouyssel 09-2004
-!     04-11-18 : 4 New arguments for AROME : Y. Seity 
-!     2005-10-10 Y. Seity : 3 optional arguments for dust optical properties 
-!     JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation (ECMWF)
-
-!-----------------------------------------------------------------------
-
-USE PARKIND1  ,ONLY : JPIM     ,JPRB
-USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
-
-USE YOEAERD  , ONLY : RCAEROS
-USE YOMCST   , ONLY :         RMD      ,RMO3
-USE YOMPHY3  , ONLY : RII0
-!USE YOERAD   , ONLY : NAER, NSW, RCCNLND  ,RCCNSEA  
-! NSW mis dans ;def MPL 20140211
-USE YOERAD   , ONLY : NAER, RCCNLND  ,RCCNSEA  
-USE YOERDU   , ONLY : REPSCQ
-USE YOMGEM   , ONLY : NGPTOT
-USE YOERDI   , ONLY : RRAE   ,REPCLC    ,REPH2O
-USE YOMARPHY , ONLY : LRDUST 
-
-!-----------------------------------------------------------------------
-
-!*       0.1   ARGUMENTS.
-!              ----------
-
-IMPLICIT NONE
-
-include "clesphys.h"
-INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
-INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
-INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
-INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
-INTEGER(KIND=JPIM)               :: KTDIA ! Argument NOT used
-INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KPROMA,NSW) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KPROMA,NSW) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KPROMA,KLEV+1)
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KPROMA,KLEV) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KPROMA,KLEV) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PQO3(KPROMA,KLEV) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KPROMA,KLEV,6) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KPROMA,KLEV) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KPROMA) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KPROMA) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KPROMA,KLEV) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KPROMA,KLEV)
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP(KPROMA,KLEV) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP(KPROMA,KLEV) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLM(KPROMA)
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA,KLEV) 
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KPROMA)
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KPROMA,KLEV,NSW)
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KPROMA,KLEV,NSW)
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUREL_DST(KPROMA,KLEV,NSW)
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_LIQ(KPROMA,KLEV)
-REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_ICE(KPROMA,KLEV)
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMTD(KPROMA,KLEV+1) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMTU(KPROMA,KLEV+1) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRSO(KPROMA,KLEV+1) 
-REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTH(KPROMA,KLEV+1)
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCTRSO(KPROMA,2) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCEMTR(KPROMA,2) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRSOD(KPROMA) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWFC(KPROMA,2) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWFT(KPROMA,KLEV+1) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWFC(KPROMA,2) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWFT(KPROMA,KLEV+1) 
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIR(KPROMA,NSW)
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIF(KPROMA,NSW)
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNN(KPROMA)
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNV(KPROMA)
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KPROMA,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KPROMA,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDN(KPROMA,KLEV+1)   ! SW total sky flux down
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUP(KPROMA,KLEV+1)   ! SW total sky flux up
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCDN(KPROMA,KLEV+1)  ! SW clear sky flux down
-REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCUP(KPROMA,KLEV+1)  ! SW clear sky flux up
-
-!     ==== COMPUTED IN RADITE ===
-!     ------------------------------------------------------------------
-!*       0.2   LOCAL ARRAYS.
-!              -------------
-REAL(KIND=JPRB) :: ZRAER  (KPROMA,6,KLEV)
-REAL(KIND=JPRB) :: ZRCLC  (KPROMA,KLEV)
-REAL(KIND=JPRB) :: ZRMU0  (KPROMA)
-REAL(KIND=JPRB) :: ZRPR   (KPROMA,KLEV)
-REAL(KIND=JPRB) :: ZRTI   (KPROMA,KLEV)
-REAL(KIND=JPRB) :: ZQLWP (KPROMA,KLEV ) , ZQIWP (KPROMA,KLEV )
-
-REAL(KIND=JPRB) :: ZPQO3 (KPROMA,KLEV)
-REAL(KIND=JPRB) :: ZQOZ (NGPTOT,KLEV)
-REAL(KIND=JPRB) :: ZQS    (KPROMA,KLEV)
-REAL(KIND=JPRB) :: ZQ     (KPROMA,KLEV)
-REAL(KIND=JPRB) :: ZEMTD  (KPROMA,KLEV+1)
-REAL(KIND=JPRB) :: ZEMTU  (KPROMA,KLEV+1)
-REAL(KIND=JPRB) :: ZTRSOC (KPROMA,2)
-REAL(KIND=JPRB) :: ZEMTC  (KPROMA,2)
-
-REAL(KIND=JPRB) :: ZNBAS  (KPROMA)
-REAL(KIND=JPRB) :: ZNTOP  (KPROMA)
-REAL(KIND=JPRB) :: ZQRAIN (KPROMA,KLEV)
-REAL(KIND=JPRB) :: ZQRAINT(KPROMA,KLEV)
-REAL(KIND=JPRB) :: ZCCNL  (KPROMA)
-REAL(KIND=JPRB) :: ZCCNO  (KPROMA)
-
-!  output of radlsw
-
-REAL(KIND=JPRB) :: ZEMIT  (KPROMA)
-REAL(KIND=JPRB) :: ZFCT   (KPROMA,KLEV+1)
-REAL(KIND=JPRB) :: ZFLT   (KPROMA,KLEV+1)
-REAL(KIND=JPRB) :: ZFCS   (KPROMA,KLEV+1)
-REAL(KIND=JPRB) :: ZFLS   (KPROMA,KLEV+1)
-REAL(KIND=JPRB) :: ZFRSOD (KPROMA),ZSUDU(KPROMA)
-REAL(KIND=JPRB) :: ZPARF  (KPROMA),ZUVDF(KPROMA),ZPARCF(KPROMA),ZTINCF(KPROMA)
-
-INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL
-
-REAL(KIND=JPRB) :: ZCRAE, ZRII0, ZEMIW(KPROMA)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-#include "radlsw.intfb.h"
-
-IF (LHOOK) CALL DR_HOOK('RECMWF',0,ZHOOK_HANDLE)
-! print *,'RECMWF: PTS=',PTS
-IBEG=KST
-IEND=KEND
-
-!*       1.    PREPARATORY WORK
-!              ----------------
-
-!*       1.1    LOCAL CONSTANTS
-!                ---------------
-
-ZRII0=RII0
-!print *,'RECMWF: RII0 PMU0=',RII0,PMU0
-ZCRAE=RRAE*(RRAE+2.0_JPRB)
-
-!*       2.1    FULL-LEVEL QUANTITIES
-
-ZRPR =PAPRSF
-
-DO JK=1,KLEV
-  DO JL=IBEG,IEND
-!   ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3
-    ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)
-    ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)))
-    IF (ZRCLC(JL,JK) > REPCLC) THEN
-      ZQLWP(JL,JK)=PQLWP(JL,JK)
-      ZQIWP(JL,JK)=PQIWP(JL,JK)
-    ELSE
-      ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
-      ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
-    ENDIF
-    ZQRAIN(JL,JK)=0.
-    ZQRAINT(JL,JK)=0.
-    ZRTI(JL,JK) =PT(JL,JK)
-    ZQS (JL,JK)=MAX(2.0_JPRB*REPH2O,PQS(JL,JK))
-    ZQ  (JL,JK)=MAX(REPH2O,MIN(PQ(JL,JK),ZQS(JL,JK)*(1.0_JPRB-REPH2O)))
-    ZEMIW(JL)=PEMIS(JL)
-  ENDDO
-ENDDO
-
-IF (NAER == 0) THEN
-  ZRAER=RCAEROS
-ELSE
-  DO JK=1,KLEV
-    DO JL=IBEG,IEND
-      ZRAER(JL,1,JK)=PAER(JL,JK,1)
-      ZRAER(JL,2,JK)=PAER(JL,JK,2)
-      ZRAER(JL,3,JK)=PAER(JL,JK,3)
-      ZRAER(JL,4,JK)=PAER(JL,JK,4)
-      ZRAER(JL,5,JK)=RCAEROS
-      ZRAER(JL,6,JK)=PAER(JL,JK,6)
-    ENDDO
-  ENDDO
-ENDIF
-
-!*       2.2    HALF-LEVEL QUANTITIES
-
-DO JK=2,KLEV
-  DO JL=IBEG,IEND
-    PTH(JL,JK)=&
-     & (PT(JL,JK-1)*PAPRSF(JL,JK-1)*(PAPRSF(JL,JK)-PAPRS(JL,JK))&
-     & +PT(JL,JK)*PAPRSF(JL,JK)*(PAPRS(JL,JK)-PAPRSF(JL,JK-1)))&
-     & *(1.0_JPRB/(PAPRS(JL,JK)*(PAPRSF(JL,JK)-PAPRSF(JL,JK-1))))  
-  ENDDO
-ENDDO
-
-!*       2.3     QUANTITIES AT BOUNDARIES
-
-DO JL=IBEG,IEND
-  PTH(JL,KLEV+1)=PTS(JL)
-  PTH(JL,1)=PT(JL,1)-PAPRSF(JL,1)*(PT(JL,1)-PTH(JL,2))&
-   & /(PAPRSF(JL,1)-PAPRS(JL,2))  
-  ZNBAS(JL)=1. 
-  ZNTOP(JL)=1.
-  ZCCNL(JL)=RCCNLND
-  ZCCNO(JL)=RCCNSEA
-ENDDO
-
-!*       3.1     SOLAR ZENITH ANGLE IS EARTH'S CURVATURE
-!                CORRECTED
-
-! CCMVAL: on impose ZRMU0=PMU0 MPL 25032010
-! 2eme essai en 3D MPL 20052010
-!DO JL=IBEG,IEND
-! ZRMU0(JL)=PMU0(JL)
-!ENDDO
-!!!!! A REVOIR MPL 20091201: enleve cette correction pour comparer a AR4
- DO JL=IBEG,IEND
-   IF (PMU0(JL) > 1.E-10_JPRB) THEN
-     ZRMU0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCRAE)-PMU0(JL))
-   ELSE
-     ZRMU0(JL)= RRAE/SQRT(ZCRAE)
-   ENDIF   
-!  print *,'RECMWF CURV: JL PMU0, ZRMU0',JL,PMU0(JL),ZRMU0(JL)
- ENDDO   
-
-
-
-!*         4.1     CALL TO ACTUAL RADIATION SCHEME
-!print *,'+++++ DANS RADLSW, LRDUST ',LRDUST
-!WRITE(*,'("PPIZA_DST=",10E12.5)') (PPIZA_DST(1,JK,1),JK=1,KLEV)
-!WRITE(*,'("PCGA_DST= ",10E12.5)') (PCGA_DST(1,JK,1),JK=1,KLEV)
-!WRITE(*,'("PTAUREL_DST=",10E12.5)') (PTAUREL_DST(1,JK,1),JK=1,KLEV)
-
-CALL RADLSW (&
- & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
- & ZRII0 ,&
- & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
- & ZCCNL , ZCCNO  ,&
- & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
- & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
- & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
- & PREF_LIQ, PREF_ICE,&
- & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
- & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
- & PSFSWDIF,PFSDNN, PFSDNV  ,&  
- & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,PFLUX,PFLUC,&
- & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
-
-!*         4.2     TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES
-
-DO JK=1,KLEV+1
-  DO JL=IBEG,IEND
-    PSWFT(JL,JK)=ZFLS(JL,JK)/(ZRII0*ZRMU0(JL))
-    PLWFT(JL,JK)=ZFLT(JL,JK)
-  ENDDO
-ENDDO
-
-ZEMTD=PLWFT
-ZEMTU=PLWFT
-
-DO JL=IBEG,IEND
-  ZTRSOC(JL, 1)=ZFCS(JL,     1)/(ZRII0*ZRMU0(JL))
-  ZTRSOC(JL, 2)=ZFCS(JL,KLEV+1)/(ZRII0*ZRMU0(JL))
-  ZEMTC (JL, 1)=ZFCT(JL,     1)
-  ZEMTC (JL, 2)=ZFCT(JL,KLEV+1)
-ENDDO
-
-!                 ------------ -- ------- -- ---- -----
-!*         5.1    STORAGE OF TRANSMISSIVITY AND EMISSIVITIES
-!*                IN KPROMA-LONG ARRAYS
-
-DO JK=1,KLEV+1
-  DO JL=IBEG,IEND
-    PEMTD(JL,JK)=ZEMTD(JL,JK)
-    PEMTU(JL,JK)=ZEMTU(JL,JK)
-    PTRSO(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PSWFT(JL,JK)))
-  ENDDO
-ENDDO
-DO JK=1,2
-  DO JL=IBEG,IEND
-    PCEMTR(JL,JK)=ZEMTC (JL,JK)
-    PCTRSO(JL,JK)=MAX( 0.0_JPRB,MIN(1.0_JPRB,ZTRSOC(JL,JK)))
-  ENDDO
-ENDDO
-DO JL=IBEG,IEND
-  PTRSOD(JL)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZFRSOD(JL)/(ZRII0*ZRMU0(JL))))
-ENDDO
-
-!*         7.3   RECONSTRUCT FLUXES FOR DIAGNOSTICS
-
-DO JL=IBEG,IEND
-  IF (PMU0(JL) < 1.E-10_JPRB) ZRMU0(JL)=0.0_JPRB
-ENDDO
-DO JK=1,KLEV+1
-  DO JL=IBEG,IEND
-    PLWFT(JL,JK)=PEMTD(JL,JK)
-    PSWFT(JL,JK)=ZRMU0(JL)*ZRII0*PTRSO(JL,JK)
-  ENDDO
-ENDDO
-DO JK=1,2
-  DO JL=IBEG,IEND
-    PSWFC(JL,JK)=ZRMU0(JL)*ZRII0*PCTRSO(JL,JK)
-    PLWFC(JL,JK)=PCEMTR(JL,JK)
-  ENDDO
-ENDDO
-
-IF (LHOOK) CALL DR_HOOK('RECMWF',1,ZHOOK_HANDLE)
-END SUBROUTINE RECMWF
