!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- !--------------- special set of characters for RCS information !----------------------------------------------------------------- ! $Source: /srv/cvsroot/MNH-VX-Y-Z/src/MNH/ini_cturb.f90,v $ $Revision: 1.2.4.1.2.2.2.1.2.2 $ $Date: 2014/01/09 15:01:55 $ !----------------------------------------------------------------- !----------------------------------------------------------------- ! ####################### MODULE MODI_IBM_FORCING_SURFEX ! ####################### ! INTERFACE ! SUBROUTINE IBM_FORCING_SURFEX(PRUS,PRVS,PRWS,PTHS,PABS,PRHO,POLD,PHEI,ICOE) ! REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS !REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRRS REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PABS REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRHO REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: POLD REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PHEI INTEGER ,INTENT(IN) :: ICOE ! END SUBROUTINE IBM_FORCING_SURFEX ! END INTERFACE ! END MODULE MODI_IBM_FORCING_SURFEX ! ! ! ! ################################################################################ SUBROUTINE IBM_FORCING_SURFEX(PRUS,PRVS,PRWS,PTHS,PABS,PRHO,POLD,PHEI,ICOE) ! ################################################################################ ! !!**** *IBM_FORCING_SURFEX* - routine to force all desired fields localized ! on the IB roof to go to ground (currently dry ! case) !! !! PURPOSE !! ------- ! !! METHOD !! ------ !! !! EXTERNAL !! -------- !! NONE !! !! IMPLICIT ARGUMENTS !! ------------------ !! !! REFERENCE !! --------- !! !! AUTHOR !! ------ !! Franck Auguste * CERFACS(AE) * !! !! MODIFICATIONS !! ------------- !! Original 01/01/2018 !! !------------------------------------------------------------------------------ ! !**** 0. DECLARATIONS ! --------------- ! ! module USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_ARGSLIST_ll, ONLY : LIST_ll ! ! declaration USE MODD_GRID_n, ONLY: XZZ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT USE MODD_IBM_PARAM_n USE MODD_LBC_n USE MODD_CONF USE MODD_CONF_n USE MODD_NSV USE MODD_CTURB USE MODD_PARAM_n ! ! interface ! IMPLICIT NONE ! !------------------------------------------------------------------------------ ! ! 0.1 declarations of arguments REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS !REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRRS REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PABS REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRHO REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: POLD REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PHEI INTEGER ,INTENT(IN) :: ICOE ! !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZTMP INTEGER :: IIE,IJE,IIB,IJB,IKB,IKE INTEGER :: JI,JJ,JN,JM,JK,JNN INTEGER :: JKMAX,IIMAX,IJMAX,KHEI ! !------------------------------------------------------------------------------ ! !**** 0. ALLOCATIONS ! -------------- CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) IKB = 1 + JPVEXT IKE = SIZE(PRWS,3) - JPVEXT ALLOCATE(ZTMP(SIZE(PRUS,1),SIZE(PRVS,2),SIZE(PRWS,3))) JKMAX = IKB DO JK=IKB,IKE-3 IF (XZZ(IIB,IJB,JK).LT.XIBM_SOLAR_MAX) JKMAX=JK+1 ENDDO ! !------------------------------------------------------------------------------ ! !**** 1. EXECUTIONS ! ------------- ! ! roof to ground IF (ICOE==0) THEN DO JN = 1,6 JM = 1 IF (JN==1) JM=2 IF (JN==2) JM=3 IF (JN==3) JM=4 IIMAX=IIE IJMAX=IJE IF (JN==1) IIMAX=IIMAX+1 IF (JN==2) IJMAX=IJMAX+1 IF (JN==1) ZTMP = PRUS IF (JN==2) ZTMP = PRVS IF (JN==3) ZTMP = PRWS IF (JN==4) ZTMP = PTHS ! IF (JN==5) ZTMP = PRRS IF (JN==5) ZTMP = PABS IF (JN==6) ZTMP = PRHO POLD(:,:,:,JN) = ZTMP(:,:,:) DO JI=IIB,IIMAX DO JJ=IJB,IJMAX IF (ABS(PHEI(JI,JJ,JM)-2.).GT.XIBM_EPSI) THEN KHEI = INT(PHEI(JI,JJ,JM)+XIBM_EPSI) ZTMP(JI,JJ,IKB) = POLD(JI,JJ,KHEI,JN) ENDIF ENDDO ENDDO ZTMP(:,:,IKB-1) = ZTMP(:,:,IKB) IF (JN==1) PRUS= ZTMP IF (JN==2) PRVS= ZTMP IF (JN==3) PRWS= ZTMP IF (JN==4) PTHS= ZTMP ! IF (JN==5) PRRS= ZTMP IF (JN==5) PABS= ZTMP IF (JN==6) PRHO= ZTMP ENDDO ENDIF ! ground to roof IF (ICOE==1) THEN DO JN = 1,6 ZTMP(:,:,:) = POLD(:,:,:,JN) IF (JN==1) PRUS= ZTMP IF (JN==2) PRVS= ZTMP IF (JN==3) PRWS= ZTMP IF (JN==4) PTHS= ZTMP ! IF (JN==5) PRRS= ZTMP IF (JN==5) PABS= ZTMP IF (JN==6) PRHO= ZTMP ENDDO ENDIF ! !------------------------------------------------------------------------------ ! !**** 2. END ! ------ DEALLOCATE(ZTMP) ! RETURN ! END SUBROUTINE IBM_FORCING_SURFEX