!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_INIT2 ! ##################### ! INTERFACE ! SUBROUTINE RECYCL_INIT2(KSAV_RECYCL1,KSAV_RECYCL2,PPTAB,PDIST,PALP) INTEGER, DIMENSION(:,:) ,INTENT(INOUT) :: KSAV_RECYCL1,KSAV_RECYCL2 REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PPTAB REAL ,INTENT(IN) :: PDIST,PALP END SUBROUTINE RECYCL_INIT2 ! END INTERFACE ! END MODULE MODI_RECYCL_INIT2 ! ! ! ! #################################### SUBROUTINE RECYCL_INIT2(KSAV_RECYCL1,KSAV_RECYCL2,PPTAB,PDIST,PALP) ! #################################### ! !!**** *RECYCL_INIT2* - 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 USE MODD_ARGSLIST_ll, ONLY : LIST_ll ! ! declaration USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT USE MODD_VAR_ll, ONLY: IP,NPROC USE MODD_CONF, ONLY: NHALO USE MODD_IBM_PARAM_n ! ! interface USE MODI_GATHER_ll USE MODI_IBM_WRITE USE MODI_RECYCL_AFFE2 ! IMPLICIT NONE ! !------------------------------------------------------------------------------ ! ! 0.1 declarations of arguments INTEGER, DIMENSION(:,:) ,INTENT(INOUT) :: KSAV_RECYCL1,KSAV_RECYCL2 REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PPTAB REAL ,INTENT(IN) :: PDIST,PALP ! !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables INTEGER :: IIU,IJU,IKU INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE INTEGER :: IIBG,IIEG,IJBG,IJEG,IIMAX,IJMAX INTEGER :: JI,JJ INTEGER :: JIMIN_RECYCL1,JJMIN_RECYCL1,JIMAX_RECYCL1,JJMAX_RECYCL1 INTEGER :: JIMIN_RECYCL2,JJMIN_RECYCL2,JIMAX_RECYCL2,JJMAX_RECYCL2 INTEGER :: I_RECYCL,JIDIST,JJDIST,JCORR REAL :: Z_DELTX,Z_DELTY INTEGER :: IINFO_ll REAL, DIMENSION(:,:,:),ALLOCATABLE:: ZPTAB0,ZPTAB1,ZPTAB2 TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! !------------------------------------------------------------------------------ ! ! Allocation and dimension ! IIU = SIZE(PPTAB,1) IJU = SIZE(PPTAB,2) IKU = SIZE(XZZ,3) CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) JIMAX_RECYCL1 = IIB-1 JJMAX_RECYCL1 = IJB-1 JIMIN_RECYCL1 = IIE+1 JJMIN_RECYCL1 = IJE+1 I_RECYCL = 0 KSAV_RECYCL1(:,:) = 0 KSAV_RECYCL2(:,:) = 0 ! ! search the reception surface ! DO JI=IIB,IIE DO JJ=IJB,IJE IF (ABS(PPTAB(JI,JJ,1)-2.)<0.001) THEN JIMIN_RECYCL1 = MIN (JIMIN_RECYCL1,JI) JJMIN_RECYCL1 = MIN (JJMIN_RECYCL1,JJ) JIMAX_RECYCL1 = MAX (JIMAX_RECYCL1,JI) JJMAX_RECYCL1 = MAX (JJMAX_RECYCL1,JJ) I_RECYCL = 1 ENDIF ENDDO ENDDO !IF (I_RECYCL == 0) RETURN CALL GET_OR_ll('B',IIBG,IJBG) IIBG = IIBG+IIB-1 IJBG = IJBG+IJB-1 !WRITE(*,*)'IIBG,IJBG',IIBG,IJBG CALL GET_GLOBALDIMS_ll( IIMAX,IJMAX) IIEG=IIBG+IIE-IIB IJEG=IJBG+IJE-IJB ! ! searching the emission surface ! Z_DELTX = XXHAT(IIB+2)-XXHAT(IIB+1) Z_DELTY = XYHAT(IJB+2)-XYHAT(IJB+1) JIDIST = INT(PDIST*cos(PALP)/Z_DELTX) JJDIST = INT(PDIST*sin(PALP)/Z_DELTY) !WRITE(*,*)'JIJDIST',JIDIST,JJDIST JIMIN_RECYCL2 = JIMIN_RECYCL1+JIDIST-IIB+IIBG JJMIN_RECYCL2 = JJMIN_RECYCL1+JJDIST-IJB+IJBG JIMAX_RECYCL2 = JIMAX_RECYCL1+JIDIST-IIB+IIBG JJMAX_RECYCL2 = JJMAX_RECYCL1+JJDIST-IJB+IJBG !IF (I_RECYCL /= 0) THEN !WRITE(*,*)JIMIN_RECYCL1,JJMIN_RECYCL1,IP !WRITE(*,*)JIMIN_RECYCL2,JJMIN_RECYCL2,IP !WRITE(*,*)JIMAX_RECYCL1,JJMAX_RECYCL1,IP !WRITE(*,*)JIMAX_RECYCL2,JJMAX_RECYCL2,IP !ENDIF IF (JIMIN_RECYCL2<1+JPHEXT) THEN JCORR = IIBG-JIMIN_RECYCL2 JIMIN_RECYCL2 = JIMIN_RECYCL2+JCORR JIMIN_RECYCL1 = JIMIN_RECYCL1+JCORR ENDIF IF (JJMIN_RECYCL2<1+JPHEXT) THEN JCORR = IJBG-JJMIN_RECYCL2 JJMIN_RECYCL2 = JJMIN_RECYCL2+JCORR JJMIN_RECYCL1 = JJMIN_RECYCL1+JCORR ENDIF IF (JIMAX_RECYCL2>IIMAX+JPHEXT) THEN JCORR = IIEG-JIMAX_RECYCL2 JIMAX_RECYCL2 = JIMAX_RECYCL2+JCORR JIMAX_RECYCL1 = JIMAX_RECYCL1+JCORR ENDIF IF (JJMAX_RECYCL2>IJMAX+JPHEXT) THEN JCORR = IJEG-JJMAX_RECYCL2 JJMAX_RECYCL2 = JJMAX_RECYCL2+JCORR JJMAX_RECYCL1 = JJMAX_RECYCL1+JCORR ENDIF !IF (I_RECYCL /= 0) THEN !WRITE(*,*)JIMIN_RECYCL1,JJMIN_RECYCL1,IP !WRITE(*,*)JIMIN_RECYCL2,JJMIN_RECYCL2,IP !WRITE(*,*)JIMAX_RECYCL1,JJMAX_RECYCL1,IP !WRITE(*,*)JIMAX_RECYCL2,JJMAX_RECYCL2,IP !ENDIF ! ! save the reception surface in the local coordinate ! save the emission surface in the global coordinate ! KSAV_RECYCL1(1,IP) = JIMIN_RECYCL1*I_RECYCL KSAV_RECYCL1(2,IP) = JJMIN_RECYCL1*I_RECYCL KSAV_RECYCL1(3,IP) = JIMAX_RECYCL1*I_RECYCL KSAV_RECYCL1(4,IP) = JJMAX_RECYCL1*I_RECYCL KSAV_RECYCL1(5,IP) = JIMIN_RECYCL2*I_RECYCL KSAV_RECYCL1(6,IP) = JJMIN_RECYCL2*I_RECYCL KSAV_RECYCL1(7,IP) = JIMAX_RECYCL2*I_RECYCL KSAV_RECYCL1(8,IP) = JJMAX_RECYCL2*I_RECYCL KSAV_RECYCL2(1,IP) = JIMIN_RECYCL1*I_RECYCL KSAV_RECYCL2(2,IP) = JJMIN_RECYCL1*I_RECYCL KSAV_RECYCL2(3,IP) = JIMAX_RECYCL1*I_RECYCL KSAV_RECYCL2(4,IP) = JJMAX_RECYCL1*I_RECYCL KSAV_RECYCL2(5,IP) = JIMIN_RECYCL2*I_RECYCL KSAV_RECYCL2(6,IP) = JJMIN_RECYCL2*I_RECYCL KSAV_RECYCL2(7,IP) = JIMAX_RECYCL2*I_RECYCL KSAV_RECYCL2(8,IP) = JJMAX_RECYCL2*I_RECYCL CALL REDUCESUM_ll(KSAV_RECYCL2,IINFO_ll) ! ! ! ALLOCATE(ZPTAB0(IIU,IJU,IKU),ZPTAB1(IIU,IJU,IKU),ZPTAB2(IIU,IJU,IKU)) ZPTAB1(IIB:IIE,IJB:IJE,1:IKU) = spread(PPTAB(IIB:IIE,IJB:IJE,2),3,IKU) ZPTAB1 = MIN(1.,ZPTAB1) ZPTAB1 = MAX(0.,ZPTAB1) WHERE(ABS(spread(PPTAB(IIB:IIE,IJB:IJE,1),3,IKU)-1.)>XIBM_EPSI) ZPTAB1(IIB:IIE,IJB:IJE,1:IKU) = 0. ZPTAB2 = ZPTAB1 ZPTAB0 = 0. CALL RECYCL_AFFE2(ZPTAB0,ZPTAB1,ZPTAB2,KSAV_RECYCL1,KSAV_RECYCL2,XDRECYCL,XARECYCL) PPTAB(:,:,2) = ZPTAB2(:,:,2) NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PPTAB(:,:,2)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) DEALLOCATE(ZPTAB0,ZPTAB1,ZPTAB2) ! ! end ! RETURN END SUBROUTINE RECYCL_INIT2