!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_AFFE2 ! ##################### ! INTERFACE ! SUBROUTINE RECYCL_AFFE2(PPTAB0,PPTAB1,PPTAB2,KSAV_RECYCL1,KSAV_RECYCL2,PDIST,PALP) REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PPTAB0,PPTAB1 REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PPTAB2 INTEGER, DIMENSION(:,:) ,INTENT(IN) :: KSAV_RECYCL1,KSAV_RECYCL2 REAL ,INTENT(IN) :: PDIST,PALP END SUBROUTINE RECYCL_AFFE2 ! END INTERFACE ! END MODULE MODI_RECYCL_AFFE2 ! ! ! ! #################################### SUBROUTINE RECYCL_AFFE2(PPTAB0,PPTAB1,PPTAB2,KSAV_RECYCL1,KSAV_RECYCL2,PDIST,PALP) ! #################################### ! !!**** *RECYCL_AFFE2* - 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_SUM_ll, ONLY : EXTRACT_ll USE MODE_POS USE MODE_ll USE MODE_IO_ll ! ! declaration USE MODD_VAR_ll, ONLY: IP, NPROC USE MODD_CONF, ONLY: NHALO ! ! interface USE MODI_GATHER_ll USE MODD_IBM_PARAM_n ! IMPLICIT NONE ! !------------------------------------------------------------------------------ ! ! 0.1 declarations of arguments REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PPTAB0,PPTAB1 REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PPTAB2 INTEGER, DIMENSION(:,:) ,INTENT(IN) :: KSAV_RECYCL1,KSAV_RECYCL2 REAL ,INTENT(IN) :: PDIST,PALP ! !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables INTEGER :: IIU,IJU,IKU, IIP REAL,DIMENSION(:,:,:) ,ALLOCATABLE :: ZTMP,ZTMP2 INTEGER :: IRESP,IINFO_ll INTEGER :: JIMIN_RECYCL1,JJMIN_RECYCL1,JIMAX_RECYCL1,JJMAX_RECYCL1 INTEGER :: JIMIN_RECYCL2,JJMIN_RECYCL2,JIMAX_RECYCL2,JJMAX_RECYCL2 INTEGER :: JIMIN_RECYCL3,JJMIN_RECYCL3,JIMAX_RECYCL3,JJMAX_RECYCL3 !------------------------------------------------------------------------------ ! ! Allocation and dimension ! IKU = SIZE(PPTAB1,3) ! ! Proc loop ! DO IIP = 1,NPROC ! ! potential index of emission/recpetion surfaces ! JIMIN_RECYCL1 = KSAV_RECYCL2(1,IIP) JJMIN_RECYCL1 = KSAV_RECYCL2(2,IIP) JIMAX_RECYCL1 = KSAV_RECYCL2(3,IIP) JJMAX_RECYCL1 = KSAV_RECYCL2(4,IIP) JIMIN_RECYCL2 = KSAV_RECYCL2(5,IIP) JJMIN_RECYCL2 = KSAV_RECYCL2(6,IIP) JIMAX_RECYCL2 = KSAV_RECYCL2(7,IIP) JJMAX_RECYCL2 = KSAV_RECYCL2(8,IIP) JIMIN_RECYCL3 = KSAV_RECYCL1(1,IIP) JJMIN_RECYCL3 = KSAV_RECYCL1(2,IIP) JIMAX_RECYCL3 = KSAV_RECYCL1(3,IIP) JJMAX_RECYCL3 = KSAV_RECYCL1(4,IIP) !CALL REDUCESUM_ll(JIMIN_RECYCL1,IINFO_ll) ! ! if proc IIP is not a reception surface : no computation ! IF (JIMIN_RECYCL1==0.AND.JJMIN_RECYCL1==0.AND.JIMAX_RECYCL1==0.AND.JJMAX_RECYCL1==0) GOTO 111 !WRITE(*,*)'IJB1',JIMIN_RECYCL1,JJMIN_RECYCL1,IIP !WRITE(*,*)'IJB2',JIMIN_RECYCL2,JJMIN_RECYCL2,IIP !WRITE(*,*)'IJE1',JIMAX_RECYCL1,JJMAX_RECYCL1,IIP !WRITE(*,*)'IJE2',JIMAX_RECYCL2,JJMAX_RECYCL2,IIP !WRITE(*,*)'EXTRACT_INI',IIP !CALL REDUCESUM_ll(JIMIN_RECYCL2,IINFO_ll) !CALL REDUCESUM_ll(JJMIN_RECYCL2,IINFO_ll) !CALL REDUCESUM_ll(JIMAX_RECYCL2,IINFO_ll) !CALL REDUCESUM_ll(JJMAX_RECYCL2,IINFO_ll) ALLOCATE(ZTMP (JIMAX_RECYCL2-JIMIN_RECYCL2+1,JJMAX_RECYCL2-JJMIN_RECYCL2+1,IKU-2)) ! ALLOCATE(ZTMP2(JIMAX_RECYCL2-JIMIN_RECYCL2+1,JJMAX_RECYCL2-JJMIN_RECYCL2+1,IKU-2)) ZTMP =0. ZTMP(:,:,:) = EXTRACT_ll(PPTAB1,IINFO_ll,JIMIN_RECYCL2,JJMIN_RECYCL2,2,JIMAX_RECYCL2,JJMAX_RECYCL2,IKU-1) ! ZTMP2=0. ! ZTMP2(:,:,:) = EXTRACT_ll(PPTAB0,IINFO_ll,JIMIN_RECYCL2,JJMIN_RECYCL2,2,JIMAX_RECYCL2,JJMAX_RECYCL2,IKU-1) !WRITE(*,*)'EXTRACT_FIN',IIP ! ! if IP is the IIP proc : affectation ! IF ( JIMIN_RECYCL1 == JIMIN_RECYCL3 .AND. & JJMIN_RECYCL1 == JJMIN_RECYCL3 .AND. & JIMAX_RECYCL1 == JIMAX_RECYCL3 .AND. & JJMAX_RECYCL1 == JJMAX_RECYCL3 ) THEN PPTAB2(JIMIN_RECYCL1:JIMAX_RECYCL1,JJMIN_RECYCL1:JJMAX_RECYCL1,2:IKU-1)= & +0.*PPTAB2(JIMIN_RECYCL1:JIMAX_RECYCL1,JJMIN_RECYCL1:JJMAX_RECYCL1,2:IKU-1) & +1.*ZTMP(1:JIMAX_RECYCL2-JIMIN_RECYCL2+1,1:JJMAX_RECYCL2-JJMIN_RECYCL2+1,1:IKU-2) ! +0.0*ZTMP2(1:JIMAX_RECYCL2-JIMIN_RECYCL2+1,1:JJMAX_RECYCL2-JJMIN_RECYCL2+1,1:IKU-2) ENDIF DEALLOCATE(ZTMP) ! DEALLOCATE(ZTMP2) 111 CONTINUE ENDDO ! ! end ! RETURN END SUBROUTINE RECYCL_AFFE2