From b32fc9c8abbc4f001a4756c17b93caab4536bd32 Mon Sep 17 00:00:00 2001
From: ESCOBAR Juan <escj@nuwa.aerologie.net>
Date: Sat, 23 Mar 2013 23:13:29 +0100
Subject: [PATCH] Juan 23/03/2012: add contrav_gpu for futur utilisation
---
MNH/contrav.f90 | 182 +++++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 173 insertions(+), 9 deletions(-)
diff --git a/MNH/contrav.f90 b/MNH/contrav.f90
index 45ec90482..3aa636585 100644
--- a/MNH/contrav.f90
+++ b/MNH/contrav.f90
@@ -8,9 +8,9 @@
MODULE MODI_CONTRAV
! ####################
!
-INTERFACE
+INTERFACE CONTRAV
!
- SUBROUTINE CONTRAV(PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ SUBROUTINE CONTRAV_CPU (PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
PRUCT,PRVCT,PRWCT )
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUT ! Cartesian comp along x
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Cartesian comp along y
@@ -24,8 +24,26 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUCT ! Contrav comp along x-bar
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRVCT ! Contrav comp along y-bar
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRWCT ! Contrav comp along z-bar
!
-END SUBROUTINE CONTRAV
+END SUBROUTINE CONTRAV_CPU
!
+ SUBROUTINE CONTRAV_ACC (IACC,PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PRUCT,PRVCT,PRWCT )
+INTEGER :: IACC
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUT ! Cartesian comp along x
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Cartesian comp along y
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWT ! Cartesian comp along z
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUCT ! Contrav comp along x-bar
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRVCT ! Contrav comp along y-bar
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRWCT ! Contrav comp along z-bar
+!$acc reflected (pdxx,pdyy,pdzz,pdzx,pdzy,prut,prvt,prwt,PRUCT,PRVCT,PRWCT)
+!
+END SUBROUTINE CONTRAV_ACC
+
END INTERFACE
!
END MODULE MODI_CONTRAV
@@ -33,7 +51,7 @@ END MODULE MODI_CONTRAV
!
!
! ##############################################################
- SUBROUTINE CONTRAV(PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ SUBROUTINE CONTRAV_CPU(PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
PRUCT,PRVCT,PRWCT )
! ##############################################################
!
@@ -140,8 +158,6 @@ IJE=SIZE(PDXX,2)-1
IKB=1+JPVEXT
IKE=SIZE(PDXX,3) - JPVEXT
!
-!$acc data copyin (pdxx,pdyy,pdzz,pdzx,pdzy,prut,prvt,prwt) local (z1,z2) copy (PRUCT,PRVCT,PRWCT)
-!$acc kernels
PRUCT(:,:,:) = PRUT(:,:,:) / PDXX(:,:,:)
PRVCT(:,:,:) = PRVT(:,:,:) / PDYY(:,:,:)
@@ -172,12 +188,160 @@ ELSE
END IF
!
-
PRWCT(:,:,1) = - PRWCT(:,:,3) ! Mirror hypothesis
+!
+!-----------------------------------------------------------------------
+!
+END SUBROUTINE CONTRAV_CPU
+!
+!
+! ##############################################################
+ SUBROUTINE CONTRAV_ACC(IACC,PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PRUCT,PRVCT,PRWCT )
+! ##############################################################
+!
+!!**** *CONTRAV * - computes the contravariant components from the
+!! cartesian components
+!!
+!! PURPOSE
+!! -------
+! This routine computes the contravariant components of vector
+! defined by its cartesian components (U,V,W) , using the following
+! formulae:
+! UC = U / DXX
+! VC = V / DYY
+! ( ----------x ----------y )
+! ( ---z ---z )
+! 1 ( U V )
+! WC = --- ( W - DZX * --- - DZY * --- )
+! DZZ ( DXX DYY )
+!
+!
+! In the no-topography case, WC = W / DZZ
+!
+!
+!!** METHOD
+!! ------
+!! We employ the Shuman operators to compute the averages. The metric
+!! coefficients PDXX, PDYY, PDZX, PDZY, PDZZ are dummy arguments
+!!
+!!
+!! EXTERNAL
+!! --------
+!! MXF, MYF, MZM : Shuman functions (mean operators)
+!!
+!! Module MODI_SHUMAN : Interface for Shuman functions
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variable
+!! LFLAT : Logical for topography
+!! = .TRUE. if Zs = 0 (Flat terrain)
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (subroutine CONTRAV)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.L. Redelsperger * CNRM *
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/07/94
+!! Corrections 3/08/94 (by J.P. Lafore)
+!! Corrections 17/10/94 (by J.P. Lafore) WC modified for w-advection
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CONF
+USE MODD_PARAMETERS
+!
+!
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER :: IACC
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUT ! Cartesian comp along x
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Cartesian comp along y
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWT ! Cartesian comp along z
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! Metric coefficients
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUCT ! Contrav comp along x-bar
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRVCT ! Contrav comp along y-bar
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRWCT ! Contrav comp along z-bar
+!$acc reflected (pdxx,pdyy,pdzz,pdzx,pdzy,prut,prvt,prwt,PRUCT,PRVCT,PRWCT)
+!
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PDXX,1),SIZE(PDXX,2),SIZE(PDXX,3)):: Z1,Z2
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
+!
+!-----------------------------------------------------------------------
+!
+!* 1. Compute the contravariant components
+! ------------------------------------
+!
+IIB=2
+IJB=2
+IIE=SIZE(PDXX,1)-1
+IJE=SIZE(PDXX,2)-1
+!
+IKB=1+JPVEXT
+IKE=SIZE(PDXX,3) - JPVEXT
+!
+!$acc data local (z1,z2 )
+!$acc kernels
+!
+PRUCT(:,:,:) = PRUT(:,:,:) / PDXX(:,:,:)
+PRVCT(:,:,:) = PRVT(:,:,:) / PDYY(:,:,:)
+
+IF (LFLAT) THEN
+
+ PRWCT(:,:,:) = PRWT(:,:,:) / PDZZ(:,:,:)
+
+ELSE
+ Z1(IIB:IIE,:,IKB:IKE+1)= &
+ (PRUCT(IIB:IIE,:,IKB:IKE+1)+PRUCT(IIB:IIE,:,IKB-1:IKE) ) &
+ *PDZX(IIB:IIE,:,IKB:IKE+1) *0.25 &
+ +(PRUCT(IIB+1:IIE+1,:,IKB:IKE+1)+PRUCT(IIB+1:IIE+1,:,IKB-1:IKE) ) &
+ *PDZX(IIB+1:IIE+1,:,IKB:IKE+1) *0.25
+
+ Z2(:,IJB:IJE,IKB:IKE+1)= &
+ (PRVCT(:,IJB:IJE,IKB:IKE+1)+PRVCT(:,IJB:IJE,IKB-1:IKE) ) &
+ *PDZY(:,IJB:IJE,IKB:IKE+1) *0.25 &
+ +(PRVCT(:,IJB+1:IJE+1,IKB:IKE+1)+PRVCT(:,IJB+1:IJE+1,IKB-1:IKE) ) &
+ *PDZY(:,IJB+1:IJE+1,IKB:IKE+1) *0.25
+
+ PRWCT=0.
+ PRWCT(IIB:IIE,IJB:IJE,IKB:IKE+1) = &
+ ( PRWT(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ - Z1(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ - Z2(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ ) / PDZZ(IIB:IIE,IJB:IJE,IKB:IKE+1)
+
+END IF
+!
+PRWCT(:,:,1) = - PRWCT(:,:,3) ! Mirror hypothesis
!$acc end kernels
-!$acc end data
+!$acc end data
!
!-----------------------------------------------------------------------
!
-END SUBROUTINE CONTRAV
+END SUBROUTINE CONTRAV_ACC
--
GitLab