From cd9a494ee57fa1458d1b94fb3920e0b6bd98d646 Mon Sep 17 00:00:00 2001 From: ESCOBAR Juan <escj@nuwa> Date: Sat, 23 Nov 2013 23:48:56 +0100 Subject: [PATCH] Juan 23/11/2013: add orig update_metrics.f90 --- MNH/update_metrics.f90 | 133 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 133 insertions(+) create mode 100644 MNH/update_metrics.f90 diff --git a/MNH/update_metrics.f90 b/MNH/update_metrics.f90 new file mode 100644 index 000000000..961dd3e6f --- /dev/null +++ b/MNH/update_metrics.f90 @@ -0,0 +1,133 @@ +!----------------------------------------------------------------- +!--------------- special set of characters for RCS information +!----------------------------------------------------------------- +! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/update_metrics.f90,v $ $Revision: 1.1.4.1 $ +! MASDEV4_7 newsrc 2006/05/18 13:07:25 +!----------------------------------------------------------------- +! ################### + MODULE MODI_UPDATE_METRICS +! ################### +INTERFACE +! +SUBROUTINE UPDATE_METRICS(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ) +CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X boundary type +CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y boundary type +! +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDXX ! metric coefficient dxx +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDYY ! metric coefficient dyy +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX ! metric coefficient dzx +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZY ! metric coefficient dzy +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZZ ! metric coefficient dzz +! +END SUBROUTINE UPDATE_METRICS +! +END INTERFACE +! +END MODULE MODI_UPDATE_METRICS +! +! +! +! ################################################################# + SUBROUTINE UPDATE_METRICS(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ) +! ################################################################# +! +!!**** *UPDATE_METRICS* - routine to set external points for metric coefficients +!! +!! PURPOSE +!! ------- +! +!!** METHOD +!! ------ +!! +!! EXTERNAL +!! -------- +!! +!! IMPLICIT ARGUMENTS +!! ------------------ +!! +!! REFERENCE +!! --------- +!! Book2 of documentation (routine UPDATE_METRICS) +!! +!! AUTHOR +!! ------ +!! V. Masson * Meteo France * +!! +!! MODIFICATIONS +!! ------------- +!! Original april 2006 +!------------------------------------------------------------------------------- +! +!* 0. DECLARATIONS +! +USE MODD_CONF +USE MODD_PARAMETERS +! +USE MODE_ll +USE MODD_ARGSLIST_ll, ONLY : LIST_ll +! +IMPLICIT NONE +! +! +!* 0.1 declarations of arguments +! +CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X boundary type +CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y boundary type +! +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDXX ! metric coefficient dxx +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDYY ! metric coefficient dyy +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX ! metric coefficient dzx +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZY ! metric coefficient dzy +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZZ ! metric coefficient dzz +! +!* 0.2 declarations of local variables +! +INTEGER :: IIB ! First physical index in x direction +INTEGER :: IJB ! First physical index in y direction +INTEGER :: JI ! loop index +! +TYPE(LIST_ll), POINTER :: TZMETRICS_ll ! list of fields to exchange +INTEGER :: IINFO_ll ! return code of parallel routine +! +!------------------------------------------------------------------------------- +! +!* 1. COMPUTE DIMENSIONS OF ARRAYS : +! ---------------------------- +IIB = 1 + JPHEXT +IJB = 1 + JPHEXT +! +NULLIFY(TZMETRICS_ll) +! +!------------------------------------------------------------------------------- +! +!* 2. UPDATE HALOs : +! ------------- +! +! +IF(NHALO == 1) THEN + CALL ADD3DFIELD_ll(TZMETRICS_ll,PDXX) + CALL ADD3DFIELD_ll(TZMETRICS_ll,PDYY) + CALL ADD3DFIELD_ll(TZMETRICS_ll,PDZX) + CALL ADD3DFIELD_ll(TZMETRICS_ll,PDZY) + CALL ADD3DFIELD_ll(TZMETRICS_ll,PDZZ) + CALL UPDATE_HALO_ll(TZMETRICS_ll,IINFO_ll) + CALL CLEANLIST_ll(TZMETRICS_ll) +END IF +! +!------------------------------------------------------------------------------- +! +!* 3. UPDATE EXTERNAL POINTS OF GLOBAL DOMAIN: +! --------------------------------------- +! +IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN + PDXX(IIB-1,:,:) = PDXX(IIB,:,:) + PDZX(IIB-1,:,:) = PDZX(IIB,:,:) +END IF +IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN + DO JI=1,SIZE(PDYY,1) + PDYY(JI,IJB-1,:) = PDYY(JI,IJB,:) + PDZY(JI,IJB-1,:) = PDZY(JI,IJB,:) + END DO +END IF +!----------------------------------------------------------------------------- +END SUBROUTINE UPDATE_METRICS -- GitLab