Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • mesonh/mesonh-code
  • quentin.rodier/mesonh-code-fork
  • benoit.vie/mesonh-code
  • joris.pianezze/mesonh-code
  • 8qq4g5s7/mesonh-code
  • jean.baptiste.filippi/meso-nh-fire-code
  • fdl68d9p/mesonh-code-sophia
7 results
Show changes
Commits on Source (217)
117 additional commits have been omitted to prevent performance issues.
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 1500 additions and 184 deletions
.gitignore 0 → 100644
View file @ 8b176c90
conf/profile_mesonh-*
exe/*
pub/ncl_ncarg*/
src/dir_obj-*
src/LIB/grib_api*
src/LIB/hdf5*
src/LIB/netcdf*
A-INSTALL
View file @ 8b176c90
#
# Version of PACKAGE MESONH "Open distribution"
# PACK-MNH-V5-1-3
# DATE : 20/11/2014
# VERSION : MESONH MASDEV5_1 + BUG-3
# PACK-MNH-V5-1-4
# DATE : 29/06/2015
# VERSION : MESONH MASDEV5_1 + BUG-4
#
# MAP
#
......@@ -81,7 +81,7 @@
#
# in the field "Show files using tag:"
#
# ---> select "PACK-MNH-V5-1-3"
# ---> select "PACK-MNH-V5-1-4"
#
# and then download the file "PACK-MNH-VX-Y-Z.tar.gz" by the link
#
......@@ -99,7 +99,7 @@ tar xvfz PACK-MNH-VX-Y-Z.tar.gz
# to the right one
#
mv MNH-VX-Y-Z MNH-V5-1-3
mv MNH-VX-Y-Z MNH-V5-1-4
#
# Process now to the chapter to configure the MesoNH
......@@ -125,7 +125,7 @@ mv MNH-VX-Y-Z MNH-V5-1-3
#
# in the field "Show files using tag:"
#
# ---> select "PACK-MNH-V5-1-3"
# ---> select "PACK-MNH-V5-1-4"
#
# download the file "anoncvs.key"
#
......@@ -200,19 +200,19 @@ export CVSROOT=:ext:mesonh_anoncvs_www:/home/cvsroot
# -------------------------------------
#
# Now, from your "$HOME" directory for example
# extract the version "PACK-MNH-V5-1-3"
# extract the version "PACK-MNH-V5-1-4"
# of the directory "MNH-VX-Y-Z" from the
# cvs repository :
cd ~
cvs co -r PACK-MNH-V5-1-3 -d MNH-V5-1-3 MNH-VX-Y-Z
cvs co -r PACK-MNH-V5-1-4 -d MNH-V5-1-4 MNH-VX-Y-Z
#
# WARNING : don't use a sub-directory with dot "." in the name
# ---> you could have some trouble when compiling mesonh
#
# this will create in your "$HOME" a directory "MNH-V5-1-3"
# which contains of the last revision named "PACK-MNH-V5-1-3"
# this will create in your "$HOME" a directory "MNH-V5-1-4"
# which contains of the last revision named "PACK-MNH-V5-1-4"
# of the MESONH PACKAGE
#
# The advantage of this way of downloading
......@@ -228,14 +228,14 @@ cvs co -r PACK-MNH-V5-1-3 -d MNH-V5-1-3 MNH-VX-Y-Z
# do
#
cd ~/MNH-V5-1-3
cvs diff -r PACK-MNH-V5-1-4
cd ~/MNH-V5-1-4
cvs diff -r PACK-MNH-V5-2-1
#
# And to upgrade your working copy
#
cd ~/MNH-V5-1-3
cd ~/MNH-V5-1-4
cvs update -r PACK-MNH-V5-1-4 -d -P
#
......@@ -251,8 +251,8 @@ cvs diff -r MNH410-BUG-branch
# ( not yet official ) version by
#
cd ~/MNH-V5-1-3
cvs update -r MNH410-BUG-branch -d -P
cd ~/MNH-V5-1-4
cvs update -r MNH51-BUG-branch -d -P
#
# Well, the use of CVS is not under the scope of this "INSTALL" document ...
......@@ -271,7 +271,7 @@ cvs update -r MNH410-BUG-branch -d -P
# use the "./configure" script like this
#
cd ~/MNH-V5-1-3/src
cd ~/MNH-V5-1-4/src
./configure
. ../conf/profile_mesonh
......@@ -316,7 +316,7 @@ export OPTLEVEL=O2 # Compile in O2 , 4 time faster then DEBUG, but least
# and then source/load the new generate file
. ../conf/profile_mesonh.LXifort.MNH-V5-1-3.MPIAUTO.O2
. ../conf/profile_mesonh.LXifort.MNH-V5-1-4.MPIAUTO.O2
#
# REM:
......@@ -341,7 +341,7 @@ export OPTLEVEL=O2 # Compile in O2 , 4 time faster then DEBUG, but least
# go to the directory "src"
#
cd ~/MNH-V5-1-3/src
cd ~/MNH-V5-1-4/src
#
# if you have not already configured your MESONH environment
......@@ -569,8 +569,8 @@ make examples
#
cd $WORKDIR
cvs co -r PACK-MNH-V5-1-3 -d MNH-V5-1-3 MNH-VX-Y-Z
cd MNH-V5-1-3/src
cvs co -r PACK-MNH-V5-1-4 -d MNH-V5-1-4 MNH-VX-Y-Z
cd MNH-V5-1-4/src
./configure
......@@ -631,7 +631,7 @@ export ARCH=LXifort
...
création du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-1-3-MPICRAY-O2
création du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-1-4-MPICRAY-O2
# And for the compilation & example job , switch the ARCH variable to LXiort :
......@@ -639,7 +639,7 @@ vi job_make_mesonh_CRAY_cca(job_make_examples_CRAY_cca)
ARCH=LXifort
#ARCH=LXcray # this is the default one
. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-1-3-MPICRAY-O2
. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-1-4-MPICRAY-O2
......@@ -730,7 +730,7 @@ scandollar
## OUTPUT ::
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-1-3/conf/post/confdollar_aeropc_default
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-1-4/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
......@@ -752,7 +752,7 @@ scandollar 0*
## OUTPUT ::
>#
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-1-3/conf/post/confdollar_aeropc_default
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-1-4/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
......@@ -826,22 +826,22 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use this "profile_mesonh" :
. /home/rech/mnh/rmnh007/DEV/MNH-V5-1-3/conf/profile_mesonh-SX8-MNH-V5-1-3-MPIAUTO-O4
. /home/rech/mnh/rmnh007/DEV/MNH-V5-1-4/conf/profile_mesonh-SX8-MNH-V5-1-4-MPIAUTO-O4
# And the examples are here ( link to my $WORKDIR in actually )
/home/rech/mnh/rmnh007/DEV/MNH-V5-1-3/MY_RUN/KTEST/007_16janvier_scandollar
/home/rech/mnh/rmnh007/DEV/MNH-V5-1-4/MY_RUN/KTEST/007_16janvier_scandollar
#
# On vargas
# ---------
# use this "profile_mesonh" :
. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-1-3/conf/profile_mesonh-AIX64-MNH-V5-1-3-MPIAUTO-O2
. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-1-4/conf/profile_mesonh-AIX64-MNH-V5-1-4-MPIAUTO-O2
# and examples here :
/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-1-3/MY_RUN/KTEST/007_16janvier_scandollar
/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-1-4/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At CINES on JADE :
......@@ -849,11 +849,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
. /work/escobar/DEV/MNH-V5-1-3/conf/profile_mesonh-LXifort-MNH-V5-1-3-MPIICE-O2
. /work/escobar/DEV/MNH-V5-1-4/conf/profile_mesonh-LXifort-MNH-V5-1-4-MPIICE-O2
# and the exemples
/work/escobar/DEV/MNH-V5-1-3/MY_RUN/KTEST/007_16janvier_scandollar
/work/escobar/DEV/MNH-V5-1-4/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At ECMWF on cxa :
......@@ -861,11 +861,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
. /c1a/ms_perm/au5/MNH-V5-1-3/conf/profile_mesonh-AIX64-MNH-V5-1-3-MPIAUTO-O2
. /c1a/ms_perm/au5/MNH-V5-1-4/conf/profile_mesonh-AIX64-MNH-V5-1-4-MPIAUTO-O2
# and the examples
/c1a/ms_perm/au5/MNH-V5-1-3/MY_RUN/KTEST/007_16janvier_scandollar
/c1a/ms_perm/au5/MNH-V5-1-4/MY_RUN/KTEST/007_16janvier_scandollar
#
......@@ -996,14 +996,14 @@ git clone -b 2014.01 https://github.com/forefireAPI/firefront.git
#
cd MNH.../src/LIB
cvs up -rPACK-MNH-V4-10-3 -d -P RTTOV
cvs up -rPACK-MNH-V5-1-4 -d -P RTTOV
#
# - With WEB access (with WEB login/pass as usually) the RTTOV package could also be retrieve in tarball with wget like this:
#
cd MNH.../src/LIB
wget --http-user=USER --http-password=PASS 'http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z/src/LIB/RTTOV/?view=tar&pathrev=PACK-MNH-V4-10-3' -O RTTOV.tar.gz
wget --http-user=USER --http-password=PASS 'http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z/src/LIB/RTTOV/?view=tar&pathrev=PACK-MNH-V5-1-4' -O RTTOV.tar.gz
tar xvfz RTTOV.tar.gz
# /!\ don't forget the ''. Otherwise, this will not work!
......
conf/post/confdollar_occigen_default 0 → 100755
View file @ 8b176c90
#!/bin/sh
#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.
##
## Run Parameter
##
export NBP=${NBP-"1"}
export TIME=${TIME-"3600"}
export MNH_EXP=${MNH_EXP-"MNH_EXP"}
export MPIRUN=${MPIRUN-"Mpirun -np ${NBP} "}
export MONORUN=${MONORUN-"Mpirun -np 1 "}
export CAT=${CAT-"cat"}
##
## exection directory
##
export SUBDIR=${SUBDIR-"${PWD}/${CONFEXP}"}
export EXECDIR=${EXECDIR-"/tmpdir/${USER}/${CONFEXP}"}
##
## transfert protocole
##
export LINKFILES=${LINKFILES-"ln -sf "}
export INDIR=${INDIR-"INDIR"}
export OUTDIR=${OUTDIR-"${INDIR}"}
case "${INHOST}" in
"" ) # default local transfert
export GETFILES=${GETFILES-"ln -s "}
export RMINDIR=${RMINDIR-"${INDIR}"}
;;
*'@'*) # ssh transfert
export GETFILES=${GETFILES-"scp"}
export RMINDIR=${RMINDIR-"${INHOST}:${INDIR}"}
;;
workdir) # get file form $workdir
export GETFILES=${GETFILES-"ln -s "}
export INDIR="${WORKDIR}/${INDIR}"
export RMINDIR="${INDIR}"
;;
esac
export OUTHOST=${OUTHOST-"${INHOST}"}
case "${OUTHOST}" in
"" ) # local transfert
export PUTFILES=${PUTFILES-"mv "}
export RMMKDIR=${RMMKDIR-"mkdir -p "}
export RMOUTDIR=${RMOUTDIR-"${OUTDIR}"}
;;
*'@'*) # ssh transfert
export PUTFILES=${PUTFILES-"scp"}
export RMMKDIR=${RMMKDIR-"ssh ${OUTHOST} mkdir -p "}
export RMOUTDIR=${RMOUTDIR-"${OUTHOST}:${OUTDIR}"}
;;
workdir) # put files in $workdir
export PUTFILES=${PUTFILES-"cp "}
export RMMKDIR=${RMMKDIR-"mkdir -p "}
export OUTDIR="${WORKDIR}/${OUTDIR}"
export RMOUTDIR="${OUTDIR}"
;;
esac
#export RMSHELL=${RMSHELL-"exec sh -c "}
export RMSHELL=${RMSHELL-"ssh -n occigen "}
export QSUB=${QSUB-"/usr/bin/sbatch"}
##
## Job Header
##
export CORE=${CORE-24}
export NCPUS=${CORE} MPIPROCS=${CORE}
export NBNODES=$( echo " scale=0 ; 1 + ( ${NBP} - 1 ) / ${NCPUS} " | bc -l )
export JOBOUT=${JOBOUT-"Sortie_${NBP}P_${CORE}C_${NBNODES}N_${VER_MPI}.%j"}
export JOBNAME=${JOBNAME-"job_${CONFEXP}"}
export JOBMULTI="\
#!/bin/bash
#SBATCH -J R`basename $PWD | cut -c -14 `
#SBATCH -e ${JOBOUT} -o ${JOBOUT}
# concatene la sortie standard avec l erreur standard
#PBS -j oe
# réservation de ${NBP} processeurs
#SBATCH -N ${NBNODES} -n ${NBP}
#SBATCH -t ${TIME}
"
export JOBMONO="\
#!/bin/bash
#SBATCH -J R`basename $PWD | cut -c -14 `
#SBATCH -eo ${JOBOUT}
# concatene la sortie standard avec l erreur standard
#PBS -j oe
# réservation de ${NBP} processeurs
#SBATCH -N ${NBNODES} -n ${NBP}
#PBS -t ${TIME}
"
export JOBSTAT=${JOBSTAT-"squeue \${SLURM_JOBID} "}
##
## Default Name of input/output files parameters ...
##
## PrepPgd
export PREP_PGD_FILES=${PREP_PGD_FILES-"${HOME}/PREP_PGD_FILES_WWW"}
export OUT_CPGDFILE=${OUT_CPGDFILE-"OUT_CPGDFILE"}
export INP_CPGDFILE_FATHER=${INP_CPGDFILE_FATHER-"INP_CPGDFILE_FATHER"}
## PrepNest
export INP_YPGD1=${INP_YPGD1-"INP_YPGD1"}
export INP_YPGD2=${INP_YPGD2-"INP_YPGD2"}
export INP_YPGD3=${INP_YPGD3-"INP_YPGD3"}
export INP_YPGD4=${INP_YPGD4-"INP_YPGD4"}
export LISTGET=${LISTGET-"LISTGET"}
export CRT_YNEST=${CRT_YNEST-"CRT_YNEST"}
export OUT_YPGD1_NEST=${OUT_YPGD1_NEST-"OUT_YPGD1_NEST"}
export OUT_YPGD2_NEST=${OUT_YPGD2_NEST-"OUT_YPGD2_NEST"}
export LISTE_PUT=${LISTE_PUT-"LISTE_PUT"}
## PrepReal
export INDIR_HATMFILE=${INDIR_HATMFILE-"${RMINDIR}"}
export INP_HATMFILE=${INP_HATMFILE-"INP_HATMFILE"}
export SUF=${SUF-"SUF"}
export INP_HPGDFILE=${INP_HPGDFILE-"INP_HPGDFILE"}
export INP_CFILE=${INP_CFILE-"INP_CFILE"}
export OUT_CINIFILE=${OUT_CINIFILE-"OUT_CINIFILE"}
## Spawning
export INP_YDOMAIN=${INP_YDOMAIN-"INP_YDOMAIN"}
export INP_CINIFILE=${INP_CINIFILE-"INP_CINIFILE"}
export OUT_CINIFILE_SPA=${OUT_CINIFILE_SPA-"OUT_CINIFILE_SPA"}
## Mesonh
export INP_CINIFILE1=${INP_CINIFILE1-"INP_CINIFILE1"}
export INP_CINIFILE2=${INP_CINIFILE2-"INP_CINIFILE2"}
export CRT_CEXP=${CRT_CEXP-"CRT_CEXP"}
export CRT_CSEG=${CRT_CSEG-"CRT_CSEG"}
export OUT_XFMOUT=${OUT_XFMOUT-"OUT_XFMOUT"}
## Diag
export INP_YINIFILE=${INP_YINIFILE-"INP_YINIFILE"}
export CRT_YSUFFIX=${CRT_YSUFFIX-"CRT_YSUFFIX"}
export OUT_DIAG=${OUT_DIAG-"OUT_DIAG"}
## Conv2dia
export CRT_CVYSUFFIX=${CRT_CVYSUFFIX-"CRT_CVYSUFFIX"}
export OUT_CVFILE=${OUT_CVFILE-"OUT_CVFILE"}
## Diaprog
export INP_FILE1=${INP_FILE1-"INP_FILE1"}
export NOVISU==${NOVISU=-"!"}
export OUT_GMFILE=${OUT_GMFILE-"OUT_GMFILE"}
src/LIB/NEWLFI/src/NEWLFI_ALL.f
View file @ 8b176c90
......@@ -6737,6 +6737,9 @@ C
IRANMS=0
INBARI=0
LLVERG=.FALSE.
CJUAN
CLACTI='UNKNOWN'
C
C Appel legerement anticipe a LFINUM, permettant une initialisa-
C tion des variables globales du logiciel a la 1ere utilisation.
......
src/LIB/RAD/ECMWF_RAD/parkind1.f90
View file @ 8b176c90
......@@ -7,6 +7,7 @@
MODULE PARKIND1
!
! *** Define usual kinds for strong typing ***
! J.Escobar : 9/06/2015, for I*8 compilation force JPIM to default size
!
IMPLICIT NONE
SAVE
......@@ -16,7 +17,8 @@ SAVE
!
INTEGER, PARAMETER :: JPIT = SELECTED_INT_KIND(2)
INTEGER, PARAMETER :: JPIS = SELECTED_INT_KIND(4)
INTEGER, PARAMETER :: JPIM = SELECTED_INT_KIND(9)
INTEGER :: JINT_DEF
INTEGER, PARAMETER :: JPIM = KIND(JINT_DEF) ! SELECTED_INT_KIND(9)
INTEGER, PARAMETER :: JPIB = SELECTED_INT_KIND(12)
!
! Real Kinds
......
src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90
View file @ 8b176c90
......@@ -1285,7 +1285,7 @@
!
!! ##########################################
SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO )
SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO, HDIR )
!! ##########################################
!
USE MODE_EXCHANGE_ll, ONLY : E_UPDATE_HALO_ll => UPDATE_HALO_ll
......@@ -1294,8 +1294,9 @@
!
TYPE(LIST_ll), POINTER :: TPLIST
INTEGER :: KINFO
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
CALL E_UPDATE_HALO_ll( TPLIST, KINFO )
CALL E_UPDATE_HALO_ll( TPLIST, KINFO, HDIR=HDIR )
!
END SUBROUTINE UPDATE_HALO_ll
!
......
src/LIB/SURCOUCHE/src/fmread_ll.f90
View file @ 8b176c90
......@@ -23,6 +23,7 @@ MODULE MODE_FMREAD
!Correction :
! J.Escobar : 22/08/2005 : BUG : manque un "GOTO 1000" si champs
! lue non trouvé !!!
! J.Escobar : 13/01/2015 : remove comment on BCAST(IRESP in FMREADX2_ll
!
USE MODD_MPIF
IMPLICIT NONE
......@@ -328,7 +329,7 @@ IF (ASSOCIATED(TZFD)) THEN
CALL SECOND_MNH2(T1)
TIMEZ%T_READ2D_READ=TIMEZ%T_READ2D_READ + T1 - T0
!
!JUAN BGQ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
IF (IRESP /= 0) GOTO 1000
!
CALL BCAST_HEADER(TZFD,TZFMH)
......
src/LIB/SURCOUCHE/src/fmwrit_ll.f90
View file @ 8b176c90
......@@ -46,8 +46,12 @@ MODULE MODE_GA
SUBROUTINE MNH_INIT_GA(MY_NI,MY_NJ,MY_NK,HRECFM,HRW_MODE)
!
! Modification
! J.Escobar 5/02/2015 : use JPHEXT from MODD_PARAMETERS_ll
USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
USE MODD_PARAMETERS, ONLY : JPHEXT
USE MODD_PARAMETERS_ll, ONLY : JPHEXT
USE MODD_IO_ll, ONLY : ISP
USE MODE_GATHER_ll, ONLY : GET_DOMWRITE_ll
USE MODE_SCATTER_ll, ONLY : GET_DOMREAD_ll
......
src/LIB/SURCOUCHE/src/mode_device.f90 0 → 100644
View file @ 8b176c90
#ifdef _FAKEOPENACC
#undef _OPENACC
#endif
MODULE MODE_DEVICE
IMPLICIT NONE
INTERFACE INIT_ON_HOST_AND_DEVICE
MODULE PROCEDURE INIT_ON_HOST_AND_DEVICE2D, INIT_ON_HOST_AND_DEVICE3D, &
INIT_ON_HOST_AND_DEVICE4D
END INTERFACE
CONTAINS
SUBROUTINE GET_FROM_DEVICE(PTAB,ZTAB,O_PTAB_ON_DEVICE)
#ifdef _OPENACC
USE&
OPENACC
#endif
IMPLICIT NONE
REAL, DIMENSION(:,:,:) :: PTAB
REAL, DIMENSION(:,:,:) :: ZTAB
LOGICAL :: O_PTAB_ON_DEVICE
#ifdef _OPENACC
O_PTAB_ON_DEVICE = acc_is_present(PTAB)
if ( O_PTAB_ON_DEVICE ) then
!$acc data create(ZTAB)
!$acc kernels
ZTAB=PTAB
!$acc end kernels
!$acc update host(ZTAB)
!$acc end data
else
ZTAB=PTAB
endif
#else
O_PTAB_ON_DEVICE = .FALSE.
ZTAB=PTAB
#endif
END SUBROUTINE GET_FROM_DEVICE
SUBROUTINE PRINT_ON_DEVICE(PTAB,MES)
#ifdef _OPENACC
USE&
OPENACC
#endif
IMPLICIT NONE
REAL, DIMENSION(:,:,:) :: PTAB
CHARACTER(len=*) :: MES
LOGICAL :: G_PTAB_ON_DEVICE,G_EXEC_ON_DEVICE
#ifdef _OPENACC
G_PTAB_ON_DEVICE = acc_is_present(PTAB)
G_EXEC_ON_DEVICE = ( acc_get_device_type() <> acc_device_host )
if (G_EXEC_ON_DEVICE) then
if (G_PTAB_ON_DEVICE) then
print*,"PRESENT::",MES
else
print*,"ABSENT ::",MES
end if
end if
#else
print*,"ABSENT ::",MES
#endif
END SUBROUTINE PRINT_ON_DEVICE
SUBROUTINE INIT_ON_HOST_AND_DEVICE2D(PTAB,PVALUE,HNAME)
#ifdef _OPENACC
USE OPENACC
#endif
! USE IEEE_ARITHMETIC
IMPLICIT NONE
REAL, DIMENSION(:,:), INTENT(INOUT) :: PTAB
REAL, OPTIONAL, INTENT(IN) :: PVALUE
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAME
LOGICAL :: O_PTAB_ON_DEVICE
REAL :: ZVALUE
CHARACTER(LEN=:),ALLOCATABLE :: YNAME
IF (PRESENT(PVALUE)) THEN
ZVALUE = PVALUE
ELSE
ZVALUE = 0.
END IF
IF (PRESENT(HNAME)) THEN
YNAME = HNAME
ELSE
YNAME = 'PTAB'
END IF
!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_SIGNALING_NAN)
!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_QUIET_NAN)
PTAB(:,:) = ZVALUE
#ifdef _OPENACC
O_PTAB_ON_DEVICE = acc_is_present(PTAB)
IF ( O_PTAB_ON_DEVICE ) THEN
!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host and device'
print *,'Initializing ',trim(YNAME),' on host and device'
!$acc update device(PTAB)
ELSE
!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host'
print *,'Initializing ',trim(YNAME),' on host'
END IF
#endif
DEALLOCATE (YNAME)
END SUBROUTINE INIT_ON_HOST_AND_DEVICE2D
SUBROUTINE INIT_ON_HOST_AND_DEVICE3D(PTAB,PVALUE,HNAME)
#ifdef _OPENACC
USE OPENACC
#endif
! USE IEEE_ARITHMETIC
IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTAB
REAL, OPTIONAL, INTENT(IN) :: PVALUE
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAME
LOGICAL :: O_PTAB_ON_DEVICE
REAL :: ZVALUE
CHARACTER(LEN=:),ALLOCATABLE :: YNAME
IF (PRESENT(PVALUE)) THEN
ZVALUE = PVALUE
ELSE
ZVALUE = 0.
END IF
IF (PRESENT(HNAME)) THEN
YNAME = HNAME
ELSE
YNAME = 'PTAB'
END IF
!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_SIGNALING_NAN)
!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_QUIET_NAN)
PTAB(:,:,:) = ZVALUE
#ifdef _OPENACC
O_PTAB_ON_DEVICE = acc_is_present(PTAB)
IF ( O_PTAB_ON_DEVICE ) THEN
!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host and device'
print *,'Initializing ',trim(YNAME),' on host and device'
!$acc update device(PTAB)
ELSE
!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host'
print *,'Initializing ',trim(YNAME),' on host'
END IF
#endif
DEALLOCATE (YNAME)
END SUBROUTINE INIT_ON_HOST_AND_DEVICE3D
SUBROUTINE INIT_ON_HOST_AND_DEVICE4D(PTAB,PVALUE,HNAME)
#ifdef _OPENACC
USE OPENACC
#endif
! USE IEEE_ARITHMETIC
IMPLICIT NONE
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PTAB
REAL, OPTIONAL, INTENT(IN) :: PVALUE
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAME
LOGICAL :: O_PTAB_ON_DEVICE
REAL :: ZVALUE
CHARACTER(LEN=:),ALLOCATABLE :: YNAME
IF (PRESENT(PVALUE)) THEN
ZVALUE = PVALUE
ELSE
ZVALUE = 0.
END IF
IF (PRESENT(HNAME)) THEN
YNAME = HNAME
ELSE
YNAME = 'PTAB'
END IF
!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_SIGNALING_NAN)
!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_QUIET_NAN)
PTAB(:,:,:,:) = ZVALUE
#ifdef _OPENACC
O_PTAB_ON_DEVICE = acc_is_present(PTAB)
IF ( O_PTAB_ON_DEVICE ) THEN
!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host and device'
print *,'Initializing ',trim(YNAME),' on host and device'
!$acc update device(PTAB)
ELSE
!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host'
print *,'Initializing ',trim(YNAME),' on host'
END IF
#endif
DEALLOCATE (YNAME)
END SUBROUTINE INIT_ON_HOST_AND_DEVICE4D
END MODULE MODE_DEVICE
#ifdef _FAKEOPENACC
#define _OPENACC
#endif
src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
View file @ 8b176c90
......@@ -91,7 +91,7 @@
CONTAINS
!
! ########################################
SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO)
SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO, HDIR )
! ########################################
!
!!**** *UPDATE_HALO_ll* - routine to update halo
......@@ -156,6 +156,7 @@
!
TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
INTEGER :: KINFO ! return status
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
!* 0.2 declarations of local variables
TYPE(LIST_ll), POINTER :: TZFIELD
......@@ -166,7 +167,7 @@
! -------------------------------------------------------------
!
CALL SEND_RECV_CRSPD(TCRRT_COMDATA%TSEND_HALO1, TCRRT_COMDATA%TRECV_HALO1, &
TPLIST, TPLIST, NHALO_COM, KINFO)
TPLIST, TPLIST, NHALO_COM, KINFO, HDIR=HDIR )
!
!* 2. UPDATE THE ZONES THE PROCESSOR SENDS OR RECEIVED FROM ITSELF
! ------------------------------------------------------------
......@@ -2136,7 +2137,7 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
! ##############################################################
SUBROUTINE SEND_RECV_CRSPD(TPCRSPDSEND, TPCRSPDRECV, &
TPFIELDLISTSEND, TPFIELDLISTRECV, &
KMPI_COMM, KINFO, KBARRIER)
KMPI_COMM, KINFO, KBARRIER, HDIR )
! ##############################################################
!
!!**** *SEND_RECV_CRSPD*-
......@@ -2233,6 +2234,7 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
INTEGER :: KMPI_COMM
INTEGER :: KINFO
INTEGER, OPTIONAL :: KBARRIER
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
!* 0.2 declarations of local variables
!
......@@ -2266,6 +2268,9 @@ INTEGER,SAVE,DIMENSION(MPI_MAX_REQ) :: REQ_TAB
INTEGER,SAVE,DIMENSION(MPI_STATUS_SIZE,MPI_MAX_REQ) :: STATUS_TAB
INTEGER :: NB_REQ,NFIRST_REQ_RECV
!endif
!
LOGICAL :: GDIR_ALL , GLX , GLY
INTEGER :: INX , INY
! JUAN
!
!-------------------------------------------------------------------------------
......@@ -2277,6 +2282,10 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
.OR.(.NOT.ASSOCIATED(TPFIELDLISTRECV))) THEN
RETURN
ENDIF
!
! init test if only halo in some direction are need
!
CALL INIT_GOOD_DIR(HDIR)
!
IF (.NOT.ASSOCIATED(TPCRSPDSEND)) THEN
ISENDNB = 0
......@@ -2340,6 +2349,7 @@ endif
! Build the send buffer
TZZONESEND => TPMAILSEND%TELT
IF (TZZONESEND%NUMBER /= IP) THEN
IF ( GOOD_DIR(TPMAILSEND) ) THEN
JINC = 0
! JUAN
!if defined (MNH_MPI_ISEND)
......@@ -2362,6 +2372,7 @@ endif
endif
ENDIF
ENDIF
TPMAILSEND => TPMAILSEND%TNEXT
ENDIF
......@@ -2377,9 +2388,8 @@ endif
! JUAN
DO WHILE (ASSOCIATED(TPMAILRECV))
IF (TPMAILRECV%TELT%NUMBER == IP) THEN
TPMAILRECV => TPMAILRECV%TNEXT
ELSE
IF (TPMAILRECV%TELT%NUMBER /= IP) THEN
IF ( GOOD_DIR(TPMAILRECV) ) THEN
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
......@@ -2395,12 +2405,12 @@ endif
JINC = 0
CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,1), JINC)
endif
! JUAN
TPMAILRECV => TPMAILRECV%TNEXT
!
! JUAN !
ENDIF
!
ENDIF
TPMAILRECV => TPMAILRECV%TNEXT
!
ENDDO
! JUAN
......@@ -2412,18 +2422,18 @@ endif
NB_REQ = NFIRST_REQ_RECV
DO WHILE (ASSOCIATED(TPMAILRECV))
IF (TPMAILRECV%TELT%NUMBER == IP) THEN
TPMAILRECV => TPMAILRECV%TNEXT
ELSE
IF (TPMAILRECV%TELT%NUMBER /= IP) THEN
IF ( GOOD_DIR(TPMAILRECV) ) THEN
!
NB_REQ = NB_REQ + 1
JINC = 0
CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,NB_REQ), JINC)
TPMAILRECV => TPMAILRECV%TNEXT
!
ENDIF
!
ENDIF
!
TPMAILRECV => TPMAILRECV%TNEXT
ENDDO
endif
!JUAN
......@@ -2439,6 +2449,86 @@ endif
ITAGOFFSET = MOD((ITAGOFFSET + NNEXTTAG), NMAXTAG)
!
!-------------------------------------------------------------------------------
!
CONTAINS
SUBROUTINE INIT_GOOD_DIR(HDIR)
!
! init the direction of halo if needed
!
USE MODD_VAR_ll, ONLY : JPHALO
!
IMPLICIT NONE
CHARACTER(len=4), OPTIONAL :: HDIR
!
IF (.NOT. PRESENT(HDIR)) THEN
GDIR_ALL = .TRUE.
ELSE
!print*,"GOOD_DIR HDIR=",HDIR,"####"
GDIR_ALL = .FALSE.
INX = 0
INY = 0
GLX = .FALSE.
GLY = .FALSE.
IF ( HDIR == "Z0_X" ) THEN
!print*,"ZZZZZ0000_XXXXXXXXXXXXXXXX"
!GDIR_ALL = .TRUE.
INX = -100 ! -100 also OK so not really needed !!!
GLX = .TRUE.
ELSEIF ( HDIR == "S0_X" ) THEN
!print*,"SSSSS0000_XXXXXXXXXXXXXXXX"
!GDIR_ALL = .TRUE.
INX = -100. ! JPHALO
GLX = .TRUE.
ELSEIF ( HDIR == "Z0_Y" ) THEN
!print*,"ZZZZZ0000_YYYYYYYYYYYYYYY"
!GDIR_ALL = .TRUE.
INY = -100 ! -100 also OK so not really needed !!!
GLY = .TRUE.
ELSEIF ( HDIR == "S0_Y" ) THEN
!print*,"SSSS0000_YYYYYYYYYYYYYYY"
!GDIR_ALL = .TRUE.
INY = -100. ! JPHALO
GLY = .TRUE.
ELSEIF ( HDIR == "01_X" ) THEN
!print*,"01_X"
!GDIR_ALL = .TRUE.
INX = JPHALO
GLX = .TRUE.
ELSEIF ( HDIR == "Z1_X" ) THEN
!print*,"ZZZZZZZZZZZZZZZZ1_X"
!GDIR_ALL = .TRUE.
INX = -100
GLX = .TRUE.
ELSEIF ( HDIR == "01_Y" ) THEN
!print*,"01_YYYYYYYYYYYYY"
!GDIR_ALL = .TRUE.
INY = JPHALO
GLY = .TRUE.
ELSE
print*,"GOOD_DIR DEFAULT :: SOMETHING WRONG !!! HDIR=",HDIR,"####"
STOP "INIT_GOOD_DIR :: SOMETHING WRONG !!! "
END IF
END IF
END SUBROUTINE INIT_GOOD_DIR
!
LOGICAL FUNCTION GOOD_DIR(TP)
IMPLICIT NONE
type(crspd_ll) :: TP
!
!GOOD_DIR = .TRUE. ; RETURN ! JUAN TEST NHALO
!
GOOD_DIR = .FALSE.
! RETURN
IF (GDIR_ALL) THEN
GOOD_DIR = .TRUE.
ELSEIF ( GLX ) THEN
GOOD_DIR = ( (TP%TELT%NXEND - TP%TELT%NXOR + 1 ) == INX ) .AND. ( (TP%TELT%NYEND - TP%TELT%NYOR + 1 ) /= INX )
ELSEIF ( GLY ) THEN
GOOD_DIR = ( (TP%TELT%NYEND - TP%TELT%NYOR + 1 ) == INY ) .AND. ( (TP%TELT%NXEND - TP%TELT%NXOR + 1 ) /= INY )
END IF
!
END FUNCTION GOOD_DIR
!
END SUBROUTINE SEND_RECV_CRSPD
!
......
src/LIB/SURCOUCHE/src/mode_mnh_world.f90
View file @ 8b176c90
#ifdef _FAKEOPENACC
#undef _OPENACC
#endif
!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
......@@ -24,6 +28,11 @@ CONTAINS
#endif
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
!JUANZ
#ifdef _OPENACC
USE OPENACC
#endif
!USE IEEE_ARITHMETIC
IMPLICIT NONE
INTEGER :: KINFO_ll
......@@ -42,6 +51,22 @@ CONTAINS
#endif
!JUANZ
#if 0
!Try to initialise device memory by creating a big array
REAL,dimension(:,:,:),allocatable :: big
!$acc declare create(big)
allocate(big(1024,1024,128))
!$acc kernels pcopyout(big)
big(:,:,:)=1e123
!big(:,:,:)=IEEE_VALUE(big(1,1,1),IEEE_QUIET_NAN)
!$acc end kernels
print *,'big=',big(1,1,1),big(1000,1024,128)
deallocate(big)
#endif
!
KINFO_ll = 0
CALL MPI_INITIALIZED(GISINIT, KINFO_ll)
......@@ -60,7 +85,21 @@ CONTAINS
! Read namelist config file
!
IF ( irank .EQ. 0 ) THEN
PRINT*,"hello world from rank=",irank," nproc=",IPROC
PRINT*,"Hello world from rank=",irank," nproc=",IPROC
#ifdef _OPENACC
IF ( OPENACC_VERSION == 201111 ) THEN
PRINT *,"Using OpenACC 1.0"
ELSE IF ( OPENACC_VERSION == 201306 ) THEN
PRINT *,"Using OpenACC 2.0"
ELSE IF ( OPENACC_VERSION == 201510 ) THEN
PRINT *,"Using OpenACC 2.5"
ELSE
PRINT *,"Using OpenACC (unknown version)"
ENDIF
PRINT *," with ",ACC_GET_NUM_DEVICES(ACC_DEVICE_NVIDIA)," NVIDIA GPU(s) (for rank 0)"
PRINT *," with ",ACC_GET_NUM_DEVICES(ACC_DEVICE_RADEON)," Radeon GPU(s) (for rank 0)"
PRINT *," with ",ACC_GET_NUM_DEVICES(ACC_DEVICE_XEONPHI)," Xeon Phi(s) (for rank 0)"
#endif
OPEN(unit=10,form="formatted",file=conf_mnh_world,STATUS='OLD',iostat=IERR)
! Read IO parameter
IF (IERR.EQ.0) THEN
......@@ -158,3 +197,7 @@ CONTAINS
END MODULE MODE_MNH_WORLD
#ifdef _FAKEOPENACC
#define _OPENACC
#endif
src/LIB/SURCOUCHE/src/mode_mppdb.f90
View file @ 8b176c90
This diff is collapsed.
src/LIB/SURCOUCHE/src/mode_sum_ll.f90
View file @ 8b176c90
......@@ -1209,6 +1209,8 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!! MODIFICATIONS
!! -------------
! Original 16/09/98
! 2016/07/04 Philippe Wautelet: compute SUM by hand instead of intrinsic Fortran
! to allow bit reproductibility with PGI compiler (16.4)
!
!-------------------------------------------------------------------------------
!
......@@ -1248,6 +1250,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
INTEGER :: IB, IE
INTEGER :: IGB, IGE
INTEGER :: IWEST, IEAST, INORTH, ISOUTH
INTEGER :: JI
!
!-------------------------------------------------------------------------------
!
......@@ -1345,8 +1348,14 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!* 3. CALCULATE THE SUM
! -----------------
!
!OCL SCALAR
ZSUM = SUM(ZGLOBFIELD(1:IGE-IGB+1))
!!OCL SCALAR
! ZSUM = SUM(ZGLOBFIELD(1:IGE-IGB+1))
ZSUM = 0.
!pgi$ novector
DO JI = 1, IGE-IGB+1
ZSUM = ZSUM + ZGLOBFIELD(JI)
END DO
!WRITE(*,'( "ZSUM in hexa",Z)') ZSUM
!
DEALLOCATE(ZGLOBFIELD)
!
......
src/LIB/SURCOUCHE/src/mode_util.f90
View file @ 8b176c90
......@@ -680,12 +680,16 @@ CONTAINS
IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__)
!!! Status for dim creation
CREATET = .TRUE.
CREATEX = .TRUE.
CREATEY = .TRUE.
CREATEZ = .TRUE.
CREATEXR = .TRUE.
CREATEZR = .TRUE.
CREATEN = .TRUE.
CREATEDATE = .TRUE.
CREATEWL = .TRUE.
CREATED = .TRUE.
WRITETIME = .TRUE.
NUMDIM = 0
first_var=hvnam
......
src/LIB/SURCOUCHE/src/modi_update_ll.f90
View file @ 8b176c90
......@@ -19,13 +19,14 @@
INTERFACE
!
!! ##########################################
SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO )
SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO, HDIR )
!! ##########################################
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
INTEGER :: KINFO ! return status
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
END SUBROUTINE UPDATE_HALO_ll
!
......
src/LIB/grib_api-1.9.9.tar.gz LFS
View file @ 8b176c90
No preview for this file type
src/LIB/netcdf-3.6.3.tar.gz LFS
View file @ 8b176c90
No preview for this file type
src/MNH/adv_boundaries.f90
View file @ 8b176c90
......@@ -6,22 +6,346 @@
MODULE MODI_ADV_BOUNDARIES
!#####################
!
INTERFACE
INTERFACE ADV_BOUNDARIES_DEVICE
MODULE PROCEDURE ADV_BOUNDARIES_DEVICE1, ADV_BOUNDARIES_DEVICE2, ADV_BOUNDARIES_DEVICE3
END INTERFACE
!
!INTERFACE
!
SUBROUTINE ADV_BOUNDARIES ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
#if 0
SUBROUTINE ADV_BOUNDARIES_DEVICE1 ( HLBCX,HLBCY,PFIELD )
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFIELDI
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
!$acc declare present(PFIELD)
!
END SUBROUTINE ADV_BOUNDARIES_DEVICE1
!
SUBROUTINE ADV_BOUNDARIES_DEVICE2 ( HLBCX,HLBCY,PFIELD,PFIELDI )
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
!$acc declare present(PFIELD,PFIELDI)
!
END SUBROUTINE ADV_BOUNDARIES_DEVICE2
!
SUBROUTINE ADV_BOUNDARIES_DEVICE3 ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIElD )
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
CHARACTER(LEN=1), INTENT(IN) :: HFIELD ! Field type
!$acc declare present(PFIELD,PFIELDI)
!
END SUBROUTINE ADV_BOUNDARIES_DEVICE3
!
SUBROUTINE ADV_BOUNDARIES ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFIELDI
CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HFIELD ! Field type
!
END SUBROUTINE ADV_BOUNDARIES
!
END INTERFACE
!
END MODULE MODI_ADV_BOUNDARIES
#endif
!
CONTAINS
!
! ####################################################################
SUBROUTINE ADV_BOUNDARIES_DEVICE1 ( HLBCX,HLBCY,PFIELD )
! ####################################################################
!
!!**** *ADV_BOUNDARIES* - routine to prepare the top and bottom Boundary Conditions
!!
!!
!! AUTHOR
!! ------
!!
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
USE MODD_PARAMETERS
USE MODE_ll
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
!$acc declare present(PFIELD)
!
!
!* 0.2 declarations of local variables
!
INTEGER :: IKB ! indice K Beginning in z direction
INTEGER :: IKE ! indice K End in z direction
INTEGER :: IIU, IJU ! Index End in X and Y directions
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
! ----------------------------------------------
IKB = 1 + JPVEXT
IKE = SIZE(PFIELD,3) - JPVEXT
IIU=SIZE(PFIELD,1)
IJU=SIZE(PFIELD,2)
!
IF (SIZE(PFIELD)==0) RETURN
!
!
!-------------------------------------------------------------------------------
!
!* 2. UPPER AND LOWER BC FILLING:
! ---------------------------
!
!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
!
!$acc kernels
PFIELD (:,:,IKB-1) = PFIELD (:,:,IKB)
!
!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
!
PFIELD (:,:,IKE+1) = PFIELD (:,:,IKE)
!$acc end kernels
!
!Not enough? !$acc update self(PFIELD(:,:,IKB-1))
!Not enough? !$acc update self(PFIELD(:,:,IKE+1))
!$acc update self(PFIELD(:,:,:))
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADV_BOUNDARIES_DEVICE1
!
! ####################################################################
SUBROUTINE ADV_BOUNDARIES_DEVICE2 ( HLBCX,HLBCY,PFIELD,PFIELDI )
! ####################################################################
!
!!**** *ADV_BOUNDARIES* - routine to prepare the top and bottom Boundary Conditions
!!
!!
!! AUTHOR
!! ------
!!
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
USE MODD_PARAMETERS
USE MODE_ll
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
!$acc declare present(PFIELD,PFIELDI)
!
!
!* 0.2 declarations of local variables
!
INTEGER :: IKB ! indice K Beginning in z direction
INTEGER :: IKE ! indice K End in z direction
INTEGER :: IIU, IJU ! Index End in X and Y directions
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
! ----------------------------------------------
IKB = 1 + JPVEXT
IKE = SIZE(PFIELD,3) - JPVEXT
IIU=SIZE(PFIELD,1)
IJU=SIZE(PFIELD,2)
!
IF (SIZE(PFIELD)==0) RETURN
!
!$acc kernels
!
!-------------------------------------------------------------------------------
!
!* 2. UPPER AND LOWER BC FILLING:
! ---------------------------
!
!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
!
!
PFIELD (:,:,IKB-1) = PFIELD (:,:,IKB)
!
!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
!
PFIELD (:,:,IKE+1) = PFIELD (:,:,IKE)
!
!
!* 3. LATERAL BC FILLING
! ---------------------------
!
IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
PFIELD(1,:,:) = PFIELDI(1,:,:)
END IF
IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
PFIELD(IIU,:,:) = PFIELDI(IIU,:,:)
END IF
IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
PFIELD(:,1,:) = PFIELDI(:,1,:)
END IF
IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
PFIELD(:,IJU,:) = PFIELDI(:,IJU,:)
END IF
!$acc end kernels
!
#if 0
!Not enough?
!$acc update self(PFIELD(:,:,IKB-1))
!$acc update self(PFIELD(:,:,IKE+1))
IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
!$acc update self(PFIELD(1,:,:))
END IF
IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
!$acc update self(PFIELD(IIU,:,:))
END IF
IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
!$acc update self(PFIELD(:,1,:))
END IF
IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
!$acc update self(PFIELD(:,IJU,:))
END IF
#else
!$acc update self(PFIELD(:,:,:))
#endif
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADV_BOUNDARIES_DEVICE2
!
! ####################################################################
SUBROUTINE ADV_BOUNDARIES_DEVICE3 ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
! ####################################################################
!
!!**** *ADV_BOUNDARIES* - routine to prepare the top and bottom Boundary Conditions
!!
!!
!! AUTHOR
!! ------
!!
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
USE MODD_PARAMETERS
USE MODE_ll
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
!$acc declare present(PFIELD,PFIELDI)
CHARACTER(LEN=1), INTENT(IN) :: HFIELD ! Field type
!
!
!* 0.2 declarations of local variables
!
INTEGER :: IKB ! indice K Beginning in z direction
INTEGER :: IKE ! indice K End in z direction
INTEGER :: IIU, IJU ! Index End in X and Y directions
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
! ----------------------------------------------
IKB = 1 + JPVEXT
IKE = SIZE(PFIELD,3) - JPVEXT
IIU=SIZE(PFIELD,1)
IJU=SIZE(PFIELD,2)
!
IF (SIZE(PFIELD)==0) RETURN
!
!$acc kernels
!
!-------------------------------------------------------------------------------
!
!* 2. UPPER AND LOWER BC FILLING:
! ---------------------------
!
!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
!
!
IF (HFIELD=='W') &
PFIELD (:,:,IKB ) = PFIELDI (:,:,IKB)
!
PFIELD (:,:,IKB-1) = PFIELD (:,:,IKB)
!
!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
!
PFIELD (:,:,IKE+1) = PFIELD (:,:,IKE)
!
!
!* 3. LATERAL BC FILLING
! ---------------------------
!
IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
PFIELD(1,:,:) = PFIELDI(1,:,:)
IF (HFIELD=='U') &
PFIELD(2,:,:) = PFIELDI(2,:,:)
END IF
IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
PFIELD(IIU,:,:) = PFIELDI(IIU,:,:)
END IF
IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
PFIELD(:,1,:) = PFIELDI(:,1,:)
IF (HFIELD=='V') &
PFIELD(:,2,:) = PFIELDI(:,2,:)
END IF
IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
PFIELD(:,IJU,:) = PFIELDI(:,IJU,:)
END IF
!$acc end kernels
!
#if 0
!Not enough?
!add also if hfield =u or v
!$acc update self(PFIELD(:,:,IKB-1))
!$acc update self(PFIELD(:,:,IKE+1))
IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
!$acc update self(PFIELD(1,:,:))
END IF
IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
!$acc update self(PFIELD(IIU,:,:))
END IF
IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
!$acc update self(PFIELD(:,1,:))
END IF
IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
!$acc update self(PFIELD(:,IJU,:))
END IF
#else
!$acc update self(PFIELD(:,:,:))
#endif
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADV_BOUNDARIES_DEVICE3
!
! ####################################################################
SUBROUTINE ADV_BOUNDARIES ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
......@@ -119,3 +443,5 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADV_BOUNDARIES
END MODULE MODI_ADV_BOUNDARIES
src/MNH/advec_4th_order_aux.f90
View file @ 8b176c90
......@@ -26,7 +26,9 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PMEANX, PMEANY ! fluxes
!$acc declare present(PMEANX,PMEANY)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
......@@ -117,6 +119,9 @@ USE MODD_LUNIT
USE MODD_CONF
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
USE MODE_IO_ll
#ifdef _OPENACC
USE MODE_DEVICE
#endif
!
IMPLICIT NONE
!
......@@ -125,8 +130,10 @@ IMPLICIT NONE
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PMEANX, PMEANY ! fluxes
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMEANX, PMEANY ! fluxes
!$acc declare present(PMEANX,PMEANY)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
......@@ -140,20 +147,41 @@ INTEGER:: IIE,IJE ! End useful area in x,y directions
!
INTEGER:: ILUOUT,IRESP ! for prints
!
! JUAN ACC
LOGICAL :: GWEST , GEAST
LOGICAL :: GSOUTH , GNORTH
REAL, DIMENSION(SIZE(PFIELDT,2),SIZE(PFIELDT,3)) :: ZHALO2_WEST,ZHALO2_EAST
REAL, DIMENSION(SIZE(PFIELDT,1),SIZE(PFIELDT,3)) :: ZHALO2_SOUTH,ZHALO2_NORTH
!$acc declare create (ZHALO2_WEST,ZHALO2_EAST,ZHALO2_SOUTH,ZHALO2_NORTH)
!
!-------------------------------------------------------------------------------
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
#ifdef _OPENACC
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_WEST,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_WEST')
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_EAST,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_EAST')
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_SOUTH,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_SOUTH')
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_NORTH,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_NORTH')
#endif
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
GWEST = LWEST_ll()
GEAST = LEAST_ll()
GSOUTH = LSOUTH_ll()
GNORTH = LNORTH_ll()
!
!-------------------------------------------------------------------------------
!
!* 0.4. INITIALIZE THE FIELDS
! ---------------------
!
!$acc kernels present(PMEANX,PMEANY)
PMEANX(:,:,:) = 0.0
PMEANY(:,:,:) = 0.0
!$acc end kernels
!
!-------------------------------------------------------------------------------
!
......@@ -167,6 +195,11 @@ SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
!
CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
ZHALO2_WEST(:,:) = TPHALO2%WEST(:,:)
ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
!$acc update device (ZHALO2_WEST,ZHALO2_EAST)
!
!$acc kernels present(PMEANX)
!!$ IF(NHALO == 1) THEN
IW=IIB+1
IE=IIE
......@@ -193,23 +226,24 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
!* lateral boundary conditions
PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0
( PFIELDT(IW,:,:)+ZHALO2_WEST(:,:) ) )/12.0
!
PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
( ZHALO2_EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
!
!* inner domain
PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0
!$acc end kernels
!
!!$!
!!$
!!$ IF(NHALO == 1) THEN
!!$ PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
!!$ ( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0
!!$ ( PFIELDT(IW,:,:)+ZPHALO2_WEST(:,:) ) )/12.0
!!$!
!!$ PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
!!$ ( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
!!$ ( ZPHALO2_EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
!!$ ENDIF
!!$!
!!$ PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
......@@ -219,7 +253,12 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
CASE ('OPEN','WALL','NEST')
!
IF (LWEST_ll()) THEN
ZHALO2_WEST(:,:) = TPHALO2%WEST(:,:)
ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
!$acc update device (ZHALO2_WEST,ZHALO2_EAST)
!
!$acc kernels present(PMEANX)
IF (GWEST) THEN
IF(KGRID == 2) THEN
IW=IIB+2 ! special case of C grid
ELSE
......@@ -232,8 +271,8 @@ CASE ('OPEN','WALL','NEST')
!!$ IW=IIB
!!$ ENDIF
ENDIF
!!$ IF (LEAST_ll() .OR. NHALO == 1) THEN
IF (LEAST_ll() ) THEN
!!$ IF (GEAST .OR. NHALO == 1) THEN
IF (GEAST) THEN
! T. Maric
! IE=IIE-1 ! original
IE=IIE
......@@ -255,7 +294,7 @@ CASE ('OPEN','WALL','NEST')
!
!* Use a second order scheme at the physical border
!
IF (LWEST_ll()) THEN
IF (GWEST) THEN
PMEANX(IWF-1,:,:) = 0.5*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) )
! T. Maric
! PMEANX(1,:,:) = PMEANX(IWF-1,:,:)
......@@ -264,21 +303,22 @@ CASE ('OPEN','WALL','NEST')
!!$ ELSE IF (NHALO == 1) THEN
ELSE
PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0
( PFIELDT(IW,:,:)+ZHALO2_WEST(:,:) ) )/12.0
ENDIF
!
IF (LEAST_ll()) THEN
IF (GEAST) THEN
PMEANX(IEF+1,:,:) = 0.5*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) )
!!$ ELSEIF (NHALO == 1) THEN
ELSE
PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
( ZHALO2_EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
ENDIF
!
!* Use a fourth order scheme elsewhere
!
PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0
!$acc end kernels
END SELECT
!
!-------------------------------------------------------------------------------
......@@ -293,6 +333,12 @@ IF ( .NOT. L2D ) THEN
!
CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
!
ZHALO2_SOUTH(:,:) = TPHALO2%SOUTH(:,:)
ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
!$acc update device (ZHALO2_SOUTH,ZHALO2_NORTH)
!
!$acc kernels present(PMEANY)
!
!
!!$ IF(NHALO == 1) THEN
IS=IJB+1
......@@ -320,21 +366,22 @@ IF ( .NOT. L2D ) THEN
!
!* lateral boundary conditions
PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:) ) - &
( PFIELDT(:,IS,:)+TPHALO2%SOUTH(:,:) ) )/12.0
( PFIELDT(:,IS,:)+ZHALO2_SOUTH(:,:) ) )/12.0
!
PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:) ) - &
( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-1,:) ) )/12.0
( ZHALO2_NORTH(:,:)+PFIELDT(:,IN-1,:) ) )/12.0
!
!* inner domain
PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0
!$acc end kernels
!!$!
!!$ IF(NHALO == 1) THEN
!!$ PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:) ) - &
!!$ ( PFIELDT(:,IS+1,:)+TPHALO2%SOUTH(:,:) ) )/12.0
!!$ ( PFIELDT(:,IS+1,:)+ZPHALO2_SOUTH(:,:) ) )/12.0
!!$!
!!$ PMEANY(:,ISF+1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:) ) - &
!!$ ( TPHALO2%NORTH(:,:)+PFIELDT(:,IS-2,:) ) )/12.0
!!$ ( ZPHALO2_NORTH(:,:)+PFIELDT(:,IS-2,:) ) )/12.0
!!$ ENDIF
!!$!
!!$ PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
......@@ -344,7 +391,12 @@ IF ( .NOT. L2D ) THEN
!
CASE ('OPEN','WALL','NEST')
!
IF (LSOUTH_ll()) THEN
ZHALO2_SOUTH(:,:) = TPHALO2%SOUTH(:,:)
ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
!$acc update device (ZHALO2_SOUTH,ZHALO2_NORTH)
!
!$acc kernels present(PMEANY)
IF (GSOUTH) THEN
IF(KGRID == 3) THEN
IS=IJB+2 ! special case of C grid
ELSE
......@@ -357,8 +409,8 @@ IF ( .NOT. L2D ) THEN
!!$ IS=IJB
!!$ ENDIF
ENDIF
!!$ IF (LNORTH_ll() .OR. NHALO == 1) THEN
IF (LNORTH_ll()) THEN
!!$ IF (GNORTH .OR. NHALO == 1) THEN
IF (GNORTH) THEN
! T. Maric
! IN=IJE-1 ! original
IN=IJE
......@@ -376,7 +428,7 @@ IF ( .NOT. L2D ) THEN
!
!* Use a second order scheme at the physical border
!
IF (LSOUTH_ll()) THEN
IF (GSOUTH) THEN
PMEANY(:,ISF-1,:) = 0.5*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:) )
! T. Maric
! PMEANY(:,1,:) = PMEANY(:,ISF-1,:)
......@@ -387,27 +439,30 @@ IF ( .NOT. L2D ) THEN
!!$ PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:)) - &
!!$ ( PFIELDT(:,IS+1,:)+TPHALO2%SOUTH(:,:) ))/12.0
PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:)) - &
( PFIELDT(:,IS,:)+TPHALO2%SOUTH(:,:) ))/12.0
( PFIELDT(:,IS,:)+ZHALO2_SOUTH(:,:) ))/12.0
ENDIF
!
IF (LNORTH_ll()) THEN
IF (GNORTH) THEN
PMEANY(:,INF+1,:) = 0.5*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:) )
!!$ ELSEIF (NHALO == 1) THEN
ELSE
!!$ PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN,:)+PFIELDT(:,IN-1,:)) - &
!!$ ( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-2,:) ))/12.0
PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:)) - &
( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-1,:) ))/12.0
( ZHALO2_NORTH(:,:)+PFIELDT(:,IN-1,:) ))/12.0
ENDIF
!
!* Use a fourth order scheme elsewhere
!
PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0
!$acc end kernels
!
END SELECT
ELSE
!$acc kernels present(PMEANY)
PMEANY(:,:,:) = 0.0
!$acc end kernels
ENDIF
!
!-------------------------------------------------------------------------------
......
src/MNH/advec_ppm_algo.f90
View file @ 8b176c90
......@@ -24,14 +24,18 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
CHARACTER (LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU, PCRV, PCRW ! Courant numbers
!$acc declare present(PCRU,PCRV,PCRW)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
!$acc declare present(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1, PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1, PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1, PRHOZ2
!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
!
......@@ -44,11 +48,69 @@ END INTERFACE
END MODULE MODI_ADVEC_PPM_ALGO
!
!
#ifdef _OPENACC
! ##########################################################################
SUBROUTINE ADVEC_PPM_ALGO(HMET_ADV_SCHEME, HLBCX, HLBCY, KGRID, PFIELDT, &
PRHODJ, PTSTEP, &
PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1,PRHOZ2,&
PSRC, KTCOUNT, PCRU, PCRV, PCRW)
!
USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
CHARACTER (LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU, PCRV, PCRW ! Courant numbers
!$acc declare present(PCRU,PCRV,PCRW)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
!$acc declare present(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1, PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1, PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1, PRHOZ2
!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRC ! source term after advection
!$acc declare present(PSRC)
INTEGER :: IZPPM
CALL MNH_GET_ZT3D(IZPPM)
CALL ADVEC_PPM_ALGO_D(HMET_ADV_SCHEME, HLBCX, HLBCY, KGRID, PFIELDT, &
& PRHODJ, PTSTEP, &
& PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1,PRHOZ2,&
& PSRC, KTCOUNT, PCRU, PCRV, PCRW, &
& ZT3D(:,:,:,IZPPM) )
CALL MNH_REL_ZT3D(IZPPM)
CONTAINS
#endif
! ##########################################################################
#ifndef _OPENACC
SUBROUTINE ADVEC_PPM_ALGO(HMET_ADV_SCHEME, HLBCX, HLBCY, KGRID, PFIELDT, &
PRHODJ, PTSTEP, &
PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1,PRHOZ2,&
PSRC, KTCOUNT, PCRU, PCRV, PCRW)
#else
SUBROUTINE ADVEC_PPM_ALGO_D(HMET_ADV_SCHEME, HLBCX, HLBCY, KGRID, PFIELDT, &
PRHODJ, PTSTEP, &
PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1,PRHOZ2,&
PSRC, KTCOUNT, PCRU, PCRV, PCRW, &
ZPPM)
#endif
! ##########################################################################
!!
!!**** *ADVEC_PPM_ALGO* - interface for 3D advection with PPM type scheme
......@@ -75,6 +137,9 @@ END MODULE MODI_ADVEC_PPM_ALGO
!! -------------
!
!USE MODE_ll
#ifdef _OPENACC
USE MODE_DEVICE
#endif
!
!USE MODD_CONF
!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
......@@ -91,23 +156,32 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
CHARACTER (LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU, PCRV, PCRW ! Courant numbers
!$acc declare present(PCRU,PCRV,PCRW)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
!$acc declare present(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1, PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1, PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1, PRHOZ2
!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRC ! source term after advection
!$acc declare present(PSRC)
!
!TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
!
!* 0.2 Declarations of local variables :
!
#ifdef _OPENACC
REAL, DIMENSION(SIZE(PFIELDT,1),SIZE(PFIELDT,2),SIZE(PFIELDT,3)) :: ZPPM ! temp PPM output
!$acc declare present(ZPPM)
#endif
!INTEGER:: IW,IE,IS,IN,IT,IB,IWF,IEF,ISF,INF ! Coordinate of 4th order diffusion area
!
!-------------------------------------------------------------------------------
......@@ -120,33 +194,61 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRC ! source term after advection
!* 0. INITIAL STEP
! ------------
!
#ifdef _OPENACC
CALL INIT_ON_HOST_AND_DEVICE(ZPPM,PVALUE=-1e99,HNAME='ADVEC_PPM_ALGO::ZPPM')
#endif
!
!$acc kernels present(PSRC,PFIELDT)
PSRC = PFIELDT
!$acc end kernels
!
SELECT CASE (HMET_ADV_SCHEME)
!
! unlimited scheme (Skamarock notation)
!
CASE('PPM_00')
#ifdef _OPENACC
PRINT *,'OPENACC: advec_ppm_algo::PPM_00 not yet tested'
CALL ABORT
#endif
!
IF (MODULO(KTCOUNT,2) .EQ. 0) THEN ! JUANTEST50
!
!* 1. ADVECTION IN X DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PTSTEP)
#else
CALL PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PTSTEP, PSRC )
#endif
!$acc kernels present(PSRC,PRHOX1)
PSRC = PSRC / PRHOX1
!$acc end kernels
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S0_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PTSTEP)
#else
CALL PPM_S0_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOY1)
PSRC = PSRC / PRHOY1
!$acc end kernels
!
!* 3. ADVECTION IN Z DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S0_Z(KGRID, PSRC, PCRW, PRHOY1, PTSTEP)
#else
CALL PPM_S0_Z(KGRID, PSRC, PCRW, PRHOY1, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOZ1)
PSRC = PSRC / PRHOZ1
!$acc end kernels
!
ELSE
!
......@@ -154,20 +256,38 @@ CASE('PPM_00')
!* 1. ADVECTION IN Z DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S0_Z(KGRID, PSRC, PCRW, PRHODJ, PTSTEP)
#else
CALL PPM_S0_Z(KGRID, PSRC, PCRW, PRHODJ, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOZ2)
PSRC = PSRC / PRHOZ2
!$acc end kernels
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S0_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PTSTEP)
#else
CALL PPM_S0_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOY2)
PSRC = PSRC / PRHOY2
!$acc end kernels
!
!* 3. ADVECTION IN X DIRECTION
! ------------------------
!
PSRC = PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP)
#ifndef _OPENACC
PSRC = PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP)
#else
CALL PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOX2)
PSRC = PSRC / PRHOX2
!$acc end kernels
!
END IF
!
......@@ -180,92 +300,180 @@ CASE('PPM_01')
!* 1. ADVECTION IN X DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = (PSRC * PRHODJ) - &
PPM_01_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PTSTEP)
PSRC = PSRC / PRHOX1
#else
CALL PPM_01_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PTSTEP, ZPPM)
!$acc kernels present(PSRC,PRHODJ,ZPPM,PRHOX1)
PSRC = ( PSRC * PRHODJ ) - ZPPM
PSRC = PSRC / PRHOX1
!$acc end kernels
#endif
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = (PSRC * PRHOX1) - &
PPM_01_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PTSTEP)
PSRC = PSRC / PRHOY1
#else
CALL PPM_01_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PTSTEP, ZPPM)
!$acc kernels present(PSRC,PRHOX1,ZPPM,PRHOY1)
PSRC = (PSRC * PRHOX1) - ZPPM
PSRC = PSRC / PRHOY1
!$acc end kernels
#endif
!
!* 3. ADVECTION IN Z DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = (PSRC * PRHOY1) - &
PPM_01_Z(KGRID, PSRC, PCRW, PRHOY1, PTSTEP)
PSRC = PSRC / PRHOZ1
#else
CALL PPM_01_Z(KGRID, PSRC, PCRW, PRHOY1, PTSTEP, ZPPM)
!$acc kernels present(PSRC,PRHOY1,ZPPM,PRHOZ1)
PSRC = (PSRC * PRHOY1) - ZPPM
PSRC = PSRC / PRHOZ1
!$acc end kernels
#endif
!
ELSE
!
!* 1. ADVECTION IN Z DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = (PSRC * PRHODJ) - &
PPM_01_Z(KGRID, PSRC, PCRW, PRHODJ, PTSTEP)
PSRC = PSRC / PRHOZ2
#else
CALL PPM_01_Z(KGRID, PSRC, PCRW, PRHODJ, PTSTEP, ZPPM)
!$acc kernels present(PSRC,PRHODJ,ZPPM,PRHOZ2)
PSRC = (PSRC * PRHODJ) - ZPPM
PSRC = PSRC / PRHOZ2
!$acc end kernels
#endif
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = (PSRC * PRHOZ2) - &
PPM_01_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PTSTEP)
PSRC = PSRC / PRHOY2
#else
CALL PPM_01_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PTSTEP, ZPPM)
!$acc kernels present(PSRC,PRHOZ2,ZPPM,PRHOY2)
PSRC = (PSRC * PRHOZ2) - ZPPM
PSRC = PSRC / PRHOY2
!$acc end kernels
#endif
!
!* 3. ADVECTION IN X DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = (PSRC * PRHOY2) - &
PPM_01_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP)
PSRC = PSRC / PRHOX2
#else
CALL PPM_01_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP, ZPPM)
!$acc kernels present(PSRC,PRHOY2,ZPPM,PRHOX2)
PSRC = (PSRC * PRHOY2) - ZPPM
PSRC = PSRC / PRHOX2
!$acc end kernels
#endif
!
END IF
!
! monotonic scheme (Skamarock notation)
!
CASE('PPM_02')
#ifdef _OPENACC
PRINT *,'OPENACC: advec_ppm_algo::PPM_02 not yet tested'
CALL ABORT
#endif
!
IF (MODULO(KTCOUNT,2) .EQ. 0) THEN
!
!* 1. ADVECTION IN X DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S1_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PRHOX1, PTSTEP)
#else
CALL PPM_S1_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PRHOX1, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOX1)
PSRC = PSRC / PRHOX1
!$acc end kernels
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S1_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PRHOY1, PTSTEP)
#else
CALL PPM_S1_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PRHOY1, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOY1)
PSRC = PSRC / PRHOY1
!$acc end kernels
!
!* 3. ADVECTION IN Z DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S1_Z(KGRID, PSRC, PCRW, PRHOY1, PRHOZ1, PTSTEP)
#else
CALL PPM_S1_Z(KGRID, PSRC, PCRW, PRHOY1, PRHOZ1, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOZ1)
PSRC = PSRC / PRHOZ1
!$acc end kernels
!
ELSE
!
!* 1. ADVECTION IN Z DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S1_Z(KGRID, PSRC, PCRW, PRHODJ, PRHOZ2, PTSTEP)
#else
CALL PPM_S1_Z(KGRID, PSRC, PCRW, PRHODJ, PRHOZ2, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOZ2)
PSRC = PSRC / PRHOZ2
!$acc end kernels
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S1_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PRHOY2, PTSTEP)
#else
CALL PPM_S1_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PRHOY2, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOY2)
PSRC = PSRC / PRHOY2
!$acc end kernels
!
!* 3. ADVECTION IN X DIRECTION
! ------------------------
!
#ifndef _OPENACC
PSRC = PPM_S1_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PRHOX2, PTSTEP)
#else
CALL PPM_S1_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PRHOX2, PTSTEP, PSRC)
#endif
!$acc kernels present(PSRC,PRHOX2)
PSRC = PSRC / PRHOX2
!$acc end kernels
!
END IF
!
......@@ -279,6 +487,12 @@ END SELECT
! compatible to the rest of the model forcings, we need to substract the
! initial field, devide by dt and muliplty by RHODJ
!
!$acc kernels present(PSRC,PFIELDT,PRHODJ)
PSRC = (PSRC - PFIELDT)*PRHODJ/PTSTEP
!$acc end kernels
!
#ifdef _OPENACC
END SUBROUTINE ADVEC_PPM_ALGO_D
#endif
!
END SUBROUTINE ADVEC_PPM_ALGO

Documentation | Mentions légales | CGU | Accessibilité : non conforme