!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***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
* 001 L. Spacek (Aug 2004) - cloud clean-up cck changes to fdc
* 002 B. Bilodeau (Feb 2007) - Output conv. and strat. tendencies
* 003 L. Spacek (Jun 2008) - Staggered version
*
*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(FDC), DBDT,
$ F(TLC), F(TSC),
$ D(TPLUS), D(TMOINS), D(HUPLUS), D(HUMOINS),
$ GZM, D(PPLUS),
$ D(SIGW), 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(SIGW) , 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)
*
* ON INTERCEPTE LES TENDANCES POUR FINS DE SORTIE
V(CTE + IK(I,K)) = ZCTE(I,K)
V(CQE + IK(I,K)) = ZCQE(I,K)
V(STE + IK(I,K)) = ZSTE(I,K)
V(SQE + IK(I,K)) = ZSQE(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(FDC),'NC', J, NI, 0.0 , 1., -1 )
c CALL MZONXST (F(FDC),'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