!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_RECYCL_AFFE ! ##################### ! INTERFACE ! SUBROUTINE RECYCL_AFFE(PPTAB1,PPTAB2,PPTAB3,PDIST,PALP) REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPTAB1 REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPTAB2 REAL, DIMENSION(:,:) ,INTENT(IN) :: PPTAB3 REAL ,INTENT(IN) :: PDIST,PALP END SUBROUTINE RECYCL_AFFE ! END INTERFACE ! END MODULE MODI_RECYCL_AFFE ! ! ! ! #################################### SUBROUTINE RECYCL_AFFE(PPTAB1,PPTAB2,PPTAB3,PDIST,PALP) ! #################################### ! !!**** *RECYCL_AFFE* - routine to genererate turbulence !! !! PURPOSE !! ------- ! SIMPLE RECYCLING METHOD ! !! METHOD !! ------ !!! !! EXTERNAL !! -------- !! NONE !! !! IMPLICIT ARGUMENTS !! ------------------ !! !! REFERENCE !! --------- !! !! AUTHOR !! ------ !! Franck Auguste * CERFACS(AE) * !! !! MODIFICATIONS !! ------------- !! Original 01/01/2015 !! !------------------------------------------------------------------------------ ! !**** 0. DECLARATIONS ! --------------- ! ! module USE MODE_POS USE MODE_ll USE MODE_IO_ll ! ! declaration USE MODD_GRID_n, ONLY: XXHAT,XYHAT USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT USE MODD_VAR_ll, ONLY: IP USE MODD_CONF, ONLY: NHALO ! ! interface USE MODI_GATHER_ll ! IMPLICIT NONE ! !------------------------------------------------------------------------------ ! ! 0.1 declarations of arguments REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPTAB1 REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPTAB2 REAL, DIMENSION(:,:) ,INTENT(IN) :: PPTAB3 REAL ,INTENT(IN) :: PDIST,PALP ! !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables INTEGER :: IIU,IJU,IKU ! domain size INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE INTEGER :: JI,JJ,JK,JN ! loop index INTEGER :: JI_ll,JJ_ll,JK_ll INTEGER :: NIMAX_ll,NJMAX_ll REAL,DIMENSION(:) ,ALLOCATABLE :: ZXHAT_ll,ZYHAT_ll REAL,DIMENSION(:) ,ALLOCATABLE :: ZPTAB1_ll,ZPTAB2_ll,ZPTAB3_ll,ZPTAB4_ll,ZPTAB5_ll REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZPTAB_ll REAL,DIMENSION(:,:,:,:) ,ALLOCATABLE :: ZTMP INTEGER :: NRESP,IINFO_ll REAL :: ZXDIST,ZYDIST ! !------------------------------------------------------------------------------ ! ! Allocation and dimension ! IIU = SIZE(PPTAB1,1) IJU = SIZE(PPTAB1,2) IKU = SIZE(PPTAB1,3) ! CALL GET_GLOBALDIMS_ll(NIMAX_ll,NJMAX_ll) ! ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT)) ALLOCATE(ZYHAT_ll(NJMAX_ll+ 2 * JPHEXT)) ALLOCATE(ZPTAB_ll(NIMAX_ll+ 2 * JPHEXT,NJMAX_ll+ 2 * JPHEXT)) ! CALL GATHERALL_FIELD_ll('XX',XXHAT ,ZXHAT_ll,NRESP) !// CALL GATHERALL_FIELD_ll('YY',XYHAT ,ZYHAT_ll,NRESP) !// CALL GATHERALL_FIELD_ll('XY',PPTAB3,ZPTAB_ll,NRESP) !// CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) ALLOCATE(ZPTAB1_ll(IKU)) ! u_bar ALLOCATE(ZPTAB2_ll(IKU)) ! v_bar ALLOCATE(ZPTAB3_ll(IKU)) ! w_bar ALLOCATE(ZPTAB4_ll(IKU)) ! t_bar ALLOCATE(ZPTAB5_ll(IKU)) ! k_bar ALLOCATE(ZTMP(IIU,IJU,IKU,5)) ZTMP=0. ! ! distance between reception and emission ! ZXDIST = PDIST*cos(PALP) ZYDIST = PDIST*sin(PALP) ! ! inlet/outlet smoothing ! DO JN=1,5 ZTMP(IIB:IIE,IJB:IJE,IKB:IKE,JN)=(6.*PPTAB1(IIB :IIE ,IJB :IJE ,IKB :IKE ,JN)*spread(PPTAB3(IIB :IIE ,IJB :IJE ),3,IKU-2)+& 1.*PPTAB1(IIB+1:IIE+1,IJB :IJE ,IKB :IKE ,JN)*spread(PPTAB3(IIB+1:IIE+1,IJB :IJE ),3,IKU-2)+& 1.*PPTAB1(IIB-1:IIE-1,IJB :IJE ,IKB :IKE ,JN)*spread(PPTAB3(IIB-1:IIE-1,IJB :IJE ),3,IKU-2)+& 1.*PPTAB1(IIB :IIE ,IJB-1:IJE-1,IKB :IKE ,JN)*spread(PPTAB3(IIB :IIE ,IJB-1:IJE-1),3,IKU-2)+& 1.*PPTAB1(IIB :IIE ,IJB+1:IJE+1,IKB :IKE ,JN)*spread(PPTAB3(IIB :IIE ,IJB+1:IJE+1),3,IKU-2)+& 1.*PPTAB1(IIB :IIE ,IJB :IJE ,IKB-1:IKE-1,JN)*spread(PPTAB3(IIB :IIE ,IJB :IJE ),3,IKU-2)+& 1.*PPTAB1(IIB :IIE ,IJB :IJE ,IKB+1:IKE+1,JN)*spread(PPTAB3(IIB :IIE ,IJB :IJE ),3,IKU-2))/12. ENDDO ! ! emission/reception of the turbulence ! DO JI_ll=1,size(ZXHAT_ll,1) DO JJ_ll=1,size(ZYHAT_ll,1) ZPTAB1_ll(:)=0. ZPTAB2_ll(:)=0. ZPTAB3_ll(:)=0. ZPTAB4_ll(:)=0. ZPTAB5_ll(:)=0. ! ! searching only emission per node ! IF (ABS(ZPTAB_ll(JI_ll,JJ_ll)-1.)<0.001) GO TO 111 DO JI=IIB,IIE DO JJ=IJB,IJE IF (XXHAT(JI)==ZXHAT_ll(JI_ll).AND.& XYHAT(JJ)==ZYHAT_ll(JJ_ll).AND.& (ABS(PPTAB3(JI,JJ)-1.)>0.001)) THEN ZPTAB1_ll(:)=ZTMP(JI,JJ,:,1) ZPTAB2_ll(:)=ZTMP(JI,JJ,:,2) ZPTAB3_ll(:)=ZTMP(JI,JJ,:,3) ZPTAB4_ll(:)=ZTMP(JI,JJ,:,4) ZPTAB5_ll(:)=ZTMP(JI,JJ,:,5) GO TO 112 ENDIF ENDDO ENDDO 111 CONTINUE 112 CONTINUE ! ! processor knowledge of the node emission ! CALL REDUCESUM_ll(ZPTAB1_ll,IINFO_ll) CALL REDUCESUM_ll(ZPTAB2_ll,IINFO_ll) CALL REDUCESUM_ll(ZPTAB3_ll,IINFO_ll) CALL REDUCESUM_ll(ZPTAB4_ll,IINFO_ll) CALL REDUCESUM_ll(ZPTAB5_ll,IINFO_ll) ! ! reception of the information by the concerned node ! DO JI=IIB,IIE DO JJ=IJB,IJE IF ((XXHAT(JI )<(ZXHAT_ll(JI_ll)-ZXDIST)).AND.& (XXHAT(JI+1)>(ZXHAT_ll(JI_ll)-ZXDIST)).AND.& (XYHAT(JJ )<(ZYHAT_ll(JJ_ll)-ZYDIST)).AND.& (XYHAT(JJ+1)>(ZYHAT_ll(JJ_ll)-ZYDIST))) THEN PPTAB2(JI,JJ,IKB:IKE,1)=PPTAB2(JI,JJ,IKB:IKE,1)+ZPTAB1_ll(IKB:IKE) PPTAB2(JI,JJ,IKB:IKE,2)=PPTAB2(JI,JJ,IKB:IKE,2)+ZPTAB2_ll(IKB:IKE) PPTAB2(JI,JJ,IKB:IKE,3)=PPTAB2(JI,JJ,IKB:IKE,3)+ZPTAB3_ll(IKB:IKE) PPTAB2(JI,JJ,IKB:IKE,4)=PPTAB2(JI,JJ,IKB:IKE,4)+ZPTAB4_ll(IKB:IKE) PPTAB2(JI,JJ,IKB:IKE,5)=PPTAB2(JI,JJ,IKB:IKE,5)+ZPTAB5_ll(IKB:IKE) ENDIF ENDDO ENDDO ENDDO ENDDO ! ! deallocation ! DEALLOCATE(ZXHAT_ll,ZYHAT_ll,ZPTAB_ll) DEALLOCATE(ZPTAB1_ll,ZPTAB2_ll,ZPTAB3_ll,ZPTAB4_ll,ZPTAB5_ll) DEALLOCATE(ZTMP) ! ! end ! RETURN END SUBROUTINE RECYCL_AFFE