!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%%
***S/P LIN_PRECIP1_TL
*
SUBROUTINE LIN_PRECIP1_TL ( D, DSIZ, F, FSIZ, V, VSIZ, 1,2
$ G, GSIZ, GZM5, GZM,
$ DT, NI, N, NK,
$ KOUNT, J, ITASK )
*
#include "impnone.cdk"
INTEGER :: FSIZ,NI,N,NK,KOUNT,J,ITASK,GSIZ,VSIZ,DSIZ
REAL, DIMENSION (DSIZ) :: D
REAL, DIMENSION (FSIZ) :: F
REAL, DIMENSION (VSIZ) :: V
REAL, DIMENSION (GSIZ) :: G
REAL, DIMENSION (N,NK) :: GZM5, GZM
REAL :: DT
*
*Author
* J.-F. Mahfouf RPN (September 2002)
*
*Revision
*
*Object
* Simplified moist physics for TL/AD versions
* to produce tendencies and precipitation from
* deep convection and large scale condensation
*
* ======================
* Tangent-linear version
* ======================
*
*Arguments
*
* - Input/Output -
* F field for permanent physics variables
* V volatile bus
* D dynamic bus
* G work space
*
* - Input -
* DSIZ dimension of D
* FSIZ dimension of F
* VSIZ dimension of V
* GSIZ dimension of G
*
* - Input -
* GZM height
*
* - Input -
* DT timestep
* NI 1st horizontal dimension
* N first dimension of T,Q,etc.
* NK vertical dimension
* KOUNT timestep number
* J index of the row for which calculations are done
* (used only for zonal diagnostics extraction)
* ITASK task number
*
*
*IMPLICITES
#include "options.cdk"
#include "consphy.cdk"
#include "phy_macros_f.h"
#include "phybus.cdk"
*
*MODULES
*
REAL :: HEURSER,CDT1
INTEGER :: IERGET, ICPU, IK, I, K
LOGICAL :: L_CONV, L_COND
**
* VARIABLES ALLOCATION DYNAMIQUE
*
AUTOMATIC ( ILAB , REAL , (NI,NK ) )
AUTOMATIC ( ZCTE , REAL , (NI,NK ) )
AUTOMATIC ( ZCQE , REAL , (NI,NK ) )
AUTOMATIC ( ZSTE , REAL , (NI,NK ) )
AUTOMATIC ( ZSQE , REAL , (NI,NK ) )
*
AUTOMATIC ( ZCTE5 , REAL , (NI,NK ) )
AUTOMATIC ( ZCQE5 , REAL , (NI,NK ) )
AUTOMATIC ( ZCCF5 , REAL , (NI,NK ) )
AUTOMATIC ( ZCRR5 , REAL , (NI ) )
AUTOMATIC ( ZCSR5 , REAL , (NI ) )
AUTOMATIC ( DBDT5 , REAL , (NI ) )
* FONCTION-FORMULE POUR L'ADRESSAGE
IK(I,K) = (K-1)*NI + I - 1
*
CDT1 = FACTDT * DT
* INITIALISATION TABLEAUX LOCAUX
ZCTE(:,:) = 0.0
ZCQE(:,:) = 0.0
ZSTE(:,:) = 0.0
ZSQE(:,:) = 0.0
*
ICPU = ITASK
*
* POSSIBLE OPTIONS FOR MOIST PHYSICS
*
IF (LIN_LSC .EQ. 100) THEN
L_CONV = .FALSE.
L_COND = .TRUE.
ELSE IF (LIN_LSC .EQ. 200) THEN
L_CONV = .TRUE.
L_COND = .FALSE.
ELSE IF (LIN_LSC .EQ. 300) THEN
L_CONV = .TRUE.
L_COND = .TRUE.
ELSE
L_CONV = .FALSE.
L_COND = .FALSE.
ENDIF
*
c CALL SERGET ( 'HEURE' , HEURSER , 1 , IERGET )
*
*
*******************************************************************
* CONVECTION *
* ---------- *
*******************************************************************
*
IF (L_CONV) THEN
CALL LIN_KUOSYM_TL (ZCTE5, ZCQE5, ILAB, ZCCF5, DBDT5,
$ ZCRR5, ZCSR5,
$ ZCTE , ZCQE, F(TLC), F(TSC),
$ D(TTRAJP), D(TTRAJM), D(HUTRAJP), D(HUTRAJM),
$ GZM5, D(PTRAJP),
$ D(TPLUS), D(TMOINS), D(HUPLUS), D(HUMOINS),
$ GZM, D(PPLUS),
$ D(SIGM), CDT1, NI, NK )
ELSE
ZCTE5(:,:) = 0.0
ZCQE5(:,:) = 0.0
ENDIF
*
*
*******************************************************************
* APPLICATION DES TENDANCES CONVECTIVES *
* ------------------------------------- *
*******************************************************************
*
DO K=1,NK
*VDIR NODEP
DO I=1,NI
D(HUTRAJP + IK(I,K)) = D(HUTRAJP + IK(I,K)) +
$ CDT1 * ZCQE5(I,K)
D(TTRAJP + IK(I,K)) = D(TTRAJP + IK(I,K)) +
$ CDT1 * ZCTE5(I,K)
D(HUPLUS + IK(I,K)) = D(HUPLUS + IK(I,K)) +
$ CDT1 * ZCQE(I,K)
D(TPLUS + IK(I,K)) = D(TPLUS + IK(I,K)) +
$ CDT1 * ZCTE(I,K)
END DO
END DO
*
*
*******************************************************************
* CONDENSATION STRATIFORME *
* ------------------------ *
*******************************************************************
*
IF (L_COND) THEN
CALL LIN_CONDS1_TL (ZSTE, ZSQE, F(TLS), F(TSS),
$ D(TPLUS), D(HUPLUS), D(PPLUS),
$ D(TTRAJP),D(HUTRAJP),D(PTRAJP),
$ D(SIGM) , CDT1, NI, NK )
ENDIF
*
*
*******************************************************************
* TENDANCES TOTALES POUR LES PROCESSUS HUMIDES *
* -------------------------------------------- *
*******************************************************************
*
DO K=1,NK
*VDIR NODEP
DO I=1,NI
V(HUCOND + IK(I,K)) = ZCQE(I,K) + ZSQE(I,K)
V(TCOND + IK(I,K)) = ZCTE(I,K) + ZSTE(I,K)
END DO
END DO
*
*******************************************************************
* EXTRACTION DE DIAGNOSTICS *
* ------------------------- *
*******************************************************************
*
* TENDANCES CONVECTIVES
c CALL SERXST (ZCTE, 'TK' , J , NI, 0.0 , 1., -1 )
c CALL MZONXST (ZCTE, 'TK' , J , NI, HEURSER, PS, -2, ICPU)
c CALL SERXST (ZCQE, 'QK' , J , NI, 0.0 , 1., -1 )
c CALL MZONXST (ZCQE, 'QK' , J , NI, HEURSER, PS, -2, ICPU)
*
* NUAGES CONVECTIFS
c CALL SERXST (F(CCK),'NC', J, NI, 0.0 , 1., -1 )
c CALL MZONXST (F(CCK),'NC', J, NI, HEURSER, 1., -1, ICPU)
*
* FLUX DES PRECIPITATIONS
c CALL SERXST (V(RNFLX), 'WF', J, NI, 0., 1., -1 )
c CALL MZONXST(V(RNFLX), 'WF', J, NI, HEURSER, 1., -1, ICPU)
*
c CALL SERXST (V(SNOFLX), 'SF', J, NI, 0., 1., -1 )
c CALL MZONXST(V(SNOFLX), 'SF', J, NI, HEURSER, 1., -1, ICPU)
*
RETURN
END SUBROUTINE LIN_PRECIP1_TL