!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$ $Revision$ !----------------------------------------------------------------- ! ######################## MODULE MODI_DEFINE_MASK_n ! ######################## ! ! INTERFACE ! SUBROUTINE DEFINE_MASK_n ! END SUBROUTINE DEFINE_MASK_n ! END INTERFACE ! END MODULE MODI_DEFINE_MASK_n ! ! ! ######################### SUBROUTINE DEFINE_MASK_n ! ######################### ! !!**** *DEFINE_MASK_n* - allocates arrays for nesting of pgds !! !! PURPOSE !! ------- ! !!** METHOD !! ------ !! !! EXTERNAL !! -------- !! !! IMPLICIT ARGUMENTS !! ------------------ !! !! REFERENCE !! --------- !! Book2 of the documentation !! !! !! AUTHOR !! ------ !! V. Masson * Meteo France * !! !! MODIFICATIONS !! ------------- !! Original 26/09/96 !! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 !! P. Wautelet : 14/04/2016 : better way to get father coordinates !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! USE MODD_DIM_n USE MODD_PARAMETERS USE MODD_CONF USE MODD_LUNIT USE MODD_NESTING USE MODD_NEST_PGD_n ! USE MODE_FM USE MODE_IO_ll USE MODE_MODELN_HANDLER ! USE MODD_VAR_ll, ONLY : YSPLITTING USE MODD_STRUCTURE_ll, ONLY : ZONE_ll USE MODE_TOOLS_ll, ONLY : INTERSECTION ! IMPLICIT NONE ! !* 0.1 declarations of arguments ! ! !* 0.2 declarations of local variables ! INTEGER :: ILUOUT0 INTEGER :: IRESP INTEGER :: ISON INTEGER :: JLOOP INTEGER :: IMI INTEGER :: IXOR_F, IYOR_F ! origin of local father subdomain (global coord) INTEGER :: IXEND_F, IYEND_F ! end of local father subdomain (global coord) INTEGER :: IXOR_C, IYOR_C ! origin of intersection between son model and local father subdomain (global coord) INTEGER :: IXEND_C, IYEND_C ! end of intersection between son model and local father subdomain (global coord) TYPE(ZONE_ll), DIMENSION(1) :: TZSPLITTING TYPE(ZONE_ll) :: TZCOARSESONGLB ! global son domain in father grid TYPE(ZONE_ll), DIMENSION(1) :: TZCOARSESONLCL ! intersection of global son domain and local father subdomain !------------------------------------------------------------------------------- ! CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP) IMI=GET_CURRENT_MODEL_INDEX() ! ALLOCATE ( NNESTMASK (NIMAX+2*JPHEXT,NJMAX+2*JPHEXT,1+COUNT(NDAD(:)==IMI))) ALLOCATE ( NSON ( 1+COUNT(NDAD(:)==IMI))) ! ! get splitting of father model ! CALL GET_OR_ll(YSPLITTING(1:1),IXOR_F,IYOR_F) IXEND_F = IXOR_F+NIMAX-1 IYEND_F = IYOR_F+NJMAX-1 ! TZSPLITTING(1)%NXOR = IXOR_F+JPHEXT TZSPLITTING(1)%NYOR = IYOR_F+JPHEXT TZSPLITTING(1)%NXEND = IXEND_F+JPHEXT TZSPLITTING(1)%NYEND = IYEND_F+JPHEXT ! TZCOARSESONGLB%NZOR = TZSPLITTING(1)%NZOR ! there is no splitting in Z direction TZCOARSESONGLB%NZEND = TZSPLITTING(1)%NZEND ! there is no splitting in Z direction TZCOARSESONGLB%NUMBER = TZSPLITTING(1)%NUMBER ! ! NNESTMASK(:,:,:) = 0 NSON(1) = IMI ! ISON=1 DO JLOOP=1,NMODEL IF (NDAD(JLOOP)/=IMI) CYCLE ISON=ISON+1 NSON(ISON)=JLOOP ! ! init global son zone in father grid coords ! TZCOARSESONGLB%NXOR = NXOR_ALL(JLOOP)+JPHEXT TZCOARSESONGLB%NYOR = NYOR_ALL(JLOOP)+JPHEXT TZCOARSESONGLB%NXEND = NXEND_ALL(JLOOP)-JPHEXT TZCOARSESONGLB%NYEND = NYEND_ALL(JLOOP)-JPHEXT ! get the intersection with local father subdomain -> TZCOARSESONLCL CALL INTERSECTION( TZSPLITTING, 1, TZCOARSESONGLB, TZCOARSESONLCL) IXOR_C = TZCOARSESONLCL(1)%NXOR IXEND_C = TZCOARSESONLCL(1)%NXEND IYOR_C = TZCOARSESONLCL(1)%NYOR IYEND_C = TZCOARSESONLCL(1)%NYEND IF ( IXEND_C/=0 .AND. IYEND_C/=0 ) THEN ! the intersection is non empty NNESTMASK( (IXOR_C-IXOR_F+1):(IXEND_C-IXOR_F+1), (IYOR_C-IYOR_F+1):(IYEND_C-IYOR_F+1), ISON) = 1 ENDIF END DO ! IF (ANY (SUM(NNESTMASK(:,:,:),DIM=3)>1) ) THEN WRITE(ILUOUT0,*) 'Two nested models in the same father are overlapping each other' !callabortstop CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP) CALL ABORT STOP END IF ! NNESTMASK(:,:,1) = 1.-SUM(NNESTMASK(:,:,:),DIM=3) !------------------------------------------------------------------------------- ! END SUBROUTINE DEFINE_MASK_n