!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. !------------------------------------------------------------------------------ ! ####################### MODULE MODI_IBM_AFFECTP_PLT ! ####################### ! INTERFACE ! SUBROUTINE IBM_AFFECTP_PLT(PTAB1,PTAB2,PTAB3,PTAB4,PTAB5,PTAB6) ! REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTAB1,PTAB2,PTAB3,PTAB4,PTAB5,PTAB6 ! !------------------------------------------------------------------------------ ! END SUBROUTINE IBM_AFFECTP_PLT ! END INTERFACE ! END MODULE MODI_IBM_AFFECTP_PLT ! ! ######################################################## SUBROUTINE IBM_AFFECTP_PLT(PTAB1,PTAB2,PTAB3,PTAB4,PTAB5,PTAB6) ! ######################################################## ! !! !! This source computes the internal temperatures (immersed multi-layer approach) !! in the hot cube case (Meinders,1999). The computation is only for the post-treatment !! !! -------- !! SUBROUTINE ? !! !! IMPLICIT ARGUMENTS !! ------------------ !! MODD_? !! !! REFERENCE !! --------- !! !! AUTHOR !! ------ !! Franck Auguste (CERFACS-AE) !! !! MODIFICATIONS !! ------------- !! Original 01/01/2018 !! !------------------------------------------------------------------------------ ! !**** 0. DECLARATIONS ! --------------- ! module USE MODE_POS USE MODE_ll USE MODE_IO_ll ! ! declaration USE MODD_IBM_PARAM_n ! ! interface USE MODD_REF_n, ONLY: XRHODJ,XRHODREF USE MODD_CST USE MODD_RADIATIONS_n USE MODD_DYN_n USE MODD_FIELD_n USE MODI_IBM_SOLAR_SHADOW USE MODD_GRID_n, ONLY: XXHAT,XYHAT ! IMPLICIT NONE ! !------------------------------------------------------------------------------ ! ! 0.1 declarations of arguments ! REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTAB1,PTAB2,PTAB3,PTAB4,PTAB5,PTAB6 ! integration period ! !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables ! INTEGER :: JI,JJ,JK,JM,JN,JMM,I_GHOST_NUMB ! loop index INTEGER :: JI1,JJ1,JK1,JI2,JJ2,JK2,JI3,JJ3,JK3 REAL, DIMENSION(:,:,:),ALLOCATABLE :: ZTAB0 TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll ! !------------------------------------------------------------------------------ ! ! 0.3 Allocation ALLOCATE(ZTAB0(SIZE(PTAB1,1),SIZE(PTAB1,2),SIZE(PTAB1,3))) ZTAB0(:,:,:)=0. ! !------------------------------------------------------------------------------ ! !**** 1. PRELIMINARIES ! ---------------- ! !**** 2. EXECUTIONS ! ------------- DO JMM=1,1 ! ! searching number of ghosts JM = size(NIBM_GHOST_P,1) JI = 0!NIBM_GHOST_P(JM,JMM,1,1) JJ = 0!NIBM_GHOST_P(JM,JMM,1,2) JK = 0!NIBM_GHOST_P(JM,JMM,1,3) DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0) JI = NIBM_GHOST_P(JM,JMM,1,1) JJ = NIBM_GHOST_P(JM,JMM,1,2) JK = NIBM_GHOST_P(JM,JMM,1,3) IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1 ENDDO I_GHOST_NUMB = JM ! ! Loop on each P Ghosts IF (I_GHOST_NUMB<=0) GO TO 667 DO JM = 1,I_GHOST_NUMB ! ! ghost index/ls JI1 = NIBM_GHOST_P(JM,JMM,1,1) JJ1 = NIBM_GHOST_P(JM,JMM,1,2) JK1 = NIBM_GHOST_P(JM,JMM,1,3) IF (JI1==0.or.JJ1==0.or.JK1==0) GO TO 778 PTAB1(JI1,JJ1,JK1) = XIBM_MOY_P(JM,JMM,1) PTAB2(JI1,JJ1,JK1) = XIBM_MOY_P(JM,JMM,2) PTAB3(JI1,JJ1,JK1) = XIBM_MOY_P(JM,JMM,3) PTAB4(JI1,JJ1,JK1) = XIBM_MOY_P(JM,JMM,6) PTAB5(JI1,JJ1,JK1) = XIBM_MOY_P(JM,JMM,7) PTAB6(JI1,JJ1,JK1) = XIBM_MOY_P(JM,JMM,8) DO JI=JI1-1,JI1+1 DO JJ=JJ1-1,JJ1+1 DO JK=JK1-1,JK1+1 IF (XIBM_LS(JI,JJ,JK,1).LT.-XIBM_EPSI) THEN PTAB1(JI,JJ,JK) = PTAB1(JI,JJ,JK)+XIBM_MOY_P(JM,JMM,1) PTAB2(JI,JJ,JK) = PTAB2(JI,JJ,JK)+XIBM_MOY_P(JM,JMM,2) PTAB3(JI,JJ,JK) = PTAB3(JI,JJ,JK)+XIBM_MOY_P(JM,JMM,3) PTAB4(JI,JJ,JK) = PTAB4(JI,JJ,JK)+XIBM_MOY_P(JM,JMM,6) PTAB5(JI,JJ,JK) = PTAB5(JI,JJ,JK)+XIBM_MOY_P(JM,JMM,7) PTAB6(JI,JJ,JK) = PTAB6(JI,JJ,JK)+XIBM_MOY_P(JM,JMM,8) ZTAB0(JI,JJ,JK) = ZTAB0(JI,JJ,JK)+1. ENDIF ENDDO ENDDO ENDDO 778 CONTINUE 779 CONTINUE ENDDO WHERE (ZTAB0(:,:,:).GT.XIBM_EPSI) PTAB1(:,:,:)=PTAB1(:,:,:)/ZTAB0(:,:,:) PTAB2(:,:,:)=PTAB2(:,:,:)/ZTAB0(:,:,:) PTAB3(:,:,:)=PTAB3(:,:,:)/ZTAB0(:,:,:) PTAB4(:,:,:)=PTAB4(:,:,:)/ZTAB0(:,:,:) PTAB5(:,:,:)=PTAB5(:,:,:)/ZTAB0(:,:,:) PTAB6(:,:,:)=PTAB6(:,:,:)/ZTAB0(:,:,:) ENDWHERE PTAB1(:,:,1)=PTAB1(:,:,2) PTAB2(:,:,1)=PTAB2(:,:,2) PTAB3(:,:,1)=PTAB3(:,:,2) PTAB4(:,:,1)=PTAB4(:,:,2) PTAB5(:,:,1)=PTAB5(:,:,2) PTAB6(:,:,1)=PTAB6(:,:,2) ENDDO 667 CONTINUE ! ! !**** X. DEALLOCATIONS/CLOSES ! ----------------------- DEALLOCATE(ZTAB0) NULLIFY(TZFIELDS_ll) CALL ADD3DFIELD_ll(TZFIELDS_ll,PTAB1(:,:,:)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PTAB2(:,:,:)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PTAB3(:,:,:)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PTAB4(:,:,:)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PTAB5(:,:,:)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PTAB6(:,:,:)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! RETURN ! END SUBROUTINE IBM_AFFECTP_PLT