!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%% ***S/P LIN_PRECIP1 *SUBROUTINE LIN_PRECIP1 ( D, DSIZ, F, FSIZ, V, VSIZ, 1,2 $ G, GSIZ, 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) :: 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 * *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 ( DBDT , REAL , (NI ) ) AUTOMATIC ( ZCTE , REAL , (NI,NK ) ) AUTOMATIC ( ZCQE , REAL , (NI,NK ) ) AUTOMATIC ( ZSTE , REAL , (NI,NK ) ) AUTOMATIC ( ZSQE , REAL , (NI,NK ) ) * FONCTION-FORMULE POUR L'ADRESSAGE IK(I,K) = (K-1)*NI + I - 1 * * 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 * CDT1 = FACTDT * DT * INITIALISATION TABLEAUX LOCAUX ZCTE(:,:) = 0.0 ZCQE(:,:) = 0.0 ZSTE(:,:) = 0.0 ZSQE(:,:) = 0.0 * ICPU = ITASK c CALL SERGET ( 'HEURE' , HEURSER , 1 , IERGET ) * * ******************************************************************* * CONVECTION * * ---------- * ******************************************************************* * IF (L_CONV) THEN CALL LIN_KUOSYM
(ZCTE, ZCQE, ILAB, F(CCK), DBDT, $ F(TLC), F(TSC), $ D(TPLUS), D(TMOINS), D(HUPLUS), D(HUMOINS), $ GZM, D(PPLUS), $ D(SIGM), CDT1, NI, NK ) ENDIF * * ******************************************************************* * APPLICATION DES TENDANCES CONVECTIVES * * ------------------------------------- * ******************************************************************* * DO K=1,NK *VDIR NODEP DO I=1,NI 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
(ZSTE, ZSQE, F(TLS), F(TSS), $ D(TPLUS), D(HUPLUS), D(PPLUS), $ 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