Skip to content
Snippets Groups Projects
Commit f5996b82 authored by Juan Escobar's avatar Juan Escobar
Browse files

Juan 11/09/2012 : first version ACC+GOODDIR OK in MONO proc

parent 1c3738f0
No related branches found
No related tags found
No related merge requests found
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/contrav.f90,v $ $Revision: 1.1.10.1 $
! MASDEV4_7 operators 2006/05/18 13:07:25
!-----------------------------------------------------------------
! ####################
MODULE MODI_CONTRAV
! ####################
!
INTERFACE
!
SUBROUTINE CONTRAV(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
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
!
END SUBROUTINE CONTRAV
!
END INTERFACE
!
END MODULE MODI_CONTRAV
!
!
!
! ##############################################################
SUBROUTINE CONTRAV(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
!
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
!
!
!* 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 region copyin (pdxx,pdyy,pdzz,pdzx,pdzy,prut,prvt,prwt) local (z1,z2)
!$acc region copyout (PRUCT,PRVCT,prwct)
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 region
!$acc end data region
!
!-----------------------------------------------------------------------
!
END SUBROUTINE CONTRAV
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/Attic/get_halo.f90,v $ $Revision: 1.1.2.1.2.2 $
! MASDEV4_7 newsrc 2007/03/01 13:18:33
!-----------------------------------------------------------------
! ####################
......@@ -87,9 +87,20 @@ INTEGER :: IERROR ! error return code
!
NULLIFY( TZ_PSRC_ll)
!
! acc update host (PSRC( IIB:IIE , IJB :IJB+JPHEXT , : ))
! acc update host (PSRC( IIB:IIE , IJE-JPHEXT :IJE , : ))
! acc update host (PSRC( IIB:IIB+JPHEXT , IJB+JPHEXT+1:IJE-JPHEXT-1 , : ))
! acc update host (PSRC( IIE-JPHEXT:IIE , IJB+JPHEXT+1:IJE-JPHEXT-1 , : ))
CALL ADD3DFIELD_ll(TZ_PSRC_ll,PSRC)
CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR, HDIR=HDIR )
CALL CLEANLIST_ll(TZ_PSRC_ll)
! acc update device (PSRC( IIB:IIE , : IJB-1 , : ))
! acc update device (PSRC( IIB:IIE , IJE+1: , : ))
! acc update device (PSRC( :IIB-1 , IJB :IJE , : ))
! acc update device (PSRC( IIE+1: , IJB :IJE , : ))
!
END SUBROUTINE GET_HALO
!-----------------------------------------------------------------------
......
This diff is collapsed.
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/metrics.f90,v $ $Revision: 1.1.8.1.2.1 $ $Date: 2009/04/21 07:42:51 $
!-----------------------------------------------------------------
!-----------------------------------------------------------------
!-----------------------------------------------------------------
! ###################
MODULE MODI_METRICS
! ###################
INTERFACE
!
SUBROUTINE METRICS(PMAP,PDXHAT,PDYHAT,PZZ, &
PDXX,PDYY,PDZX,PDZY,PDZZ)
REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! Map factor
REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height in z direction
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZX ! metric coefficient dzx
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZY ! metric coefficient dzy
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZZ ! metric coefficient dzz
!
END SUBROUTINE METRICS
!
END INTERFACE
!
END MODULE MODI_METRICS
!
!
!
! #################################################################
SUBROUTINE METRICS(PMAP,PDXHAT,PDYHAT,PZZ, &
PDXX,PDYY,PDZX,PDZY,PDZZ)
! #################################################################
!
!!**** *METRICS* - routine to compute metric coefficients
!!
!! PURPOSE
!! -------
! The purpose of this routine is to compute the metric coefficients
! dxx,dyy,dzz,dzx,dzy
!
!!** METHOD
!! ------
!! The horizontal coefficients dxx and dyy (PDXX and PDYY arrays)
!! are computed according to the thinshell or no thinshell approximation
!! and to the cartesian or spherical geometry.
!!
!! EXTERNAL
!! --------
!! MXM,MYM,MZM : Shuman functions (mean operators)
!! DXM,DYM,DZM : Shuman functions (finite differences operators)
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : contains physical constants
!!
!! XRADIUS : earth radius
!!
!! Module MODD_CONF : contains configuration variables
!!
!! LTHINSHELL : Logical for thinshell approximation
!! .TRUE. = Thinshell approximation done
!! LCARTESIAN : Logical for cartesian geometry
!! .TRUE. = Cartesian geometry used
!!
!! REFERENCE
!! ---------
!! Book2 of documentation (routine METRICS)
!!
!! AUTHOR
!! ------
!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 12/07/94
!! 14/02/01 (V. Masson and J. Stein) PDZZ initialized below the surface
!! (influences the 3D turbulence of W) and PDXX,PDYY,PDZZ at the top
!! 19/03/2008 (J.Escobar) remove spread !!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
USE MODD_CONF
USE MODD_CST
!
USE MODI_SHUMAN
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! Map factor
REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZX ! metric coefficient dzx
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZY ! metric coefficient dzy
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZZ ! metric coefficient dzz
!
!* 0.2 declarations of local variables
!
INTEGER :: IIU ! Upper dimension in x direction
INTEGER :: IJU ! Upper dimension in y direction
INTEGER :: IKU ! Upper dimension in z direction
REAL :: ZD1 ! DELTA1 (switch 0/1) for thinshell
! approximation
INTEGER :: JI,JJ,JK
REAL, DIMENSION(SIZE(PDXHAT),SIZE(PDYHAT),SIZE(PZZ,3)) :: ZDZZ
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS :
! ----------------------------
IIU = SIZE(PDXHAT)
IJU = SIZE(PDYHAT)
IKU = SIZE(PZZ,3)
!
!-------------------------------------------------------------------------------
!
!* 2. COMPUTE PDXX and PDYY :
! --------------------
!
IF (LTHINSHELL) THEN
ZD1=0.
ELSE
ZD1=1.
END IF
IF (.NOT.LCARTESIAN) THEN
ZDZZ(:,:,:) = MZF( 1.+ ZD1*PZZ(:,:,:)/XRADIUS)
DO JK=1,IKU ; DO JJ=1,IJU ; DO JI=1,IIU
PDXX(JI,JJ,JK) = ZDZZ(JI,JJ,JK) * PDXHAT(JI) /PMAP(JI,JJ)
PDYY(JI,JJ,JK) = ZDZZ(JI,JJ,JK) * PDYHAT(JJ) /PMAP(JI,JJ)
ENDDO ; ENDDO ; ENDDO
PDXX(:,:,:)=MXM(PDXX(:,:,:))
PDXX(:,:,IKU)=PDXX(:,:,IKU-1)
PDYY(:,:,:)=MYM(PDYY(:,:,:))
PDYY(:,:,IKU)=PDYY(:,:,IKU-1)
ELSE
DO JK=1,IKU ; DO JJ=1,IJU ; DO JI=1,IIU
PDXX(JI,JJ,JK) = PDXHAT(JI)
PDYY(JI,JJ,JK) = PDYHAT(JJ)
ENDDO ; ENDDO ; ENDDO
PDXX(:,:,:)=MXM(PDXX(:,:,:))
PDYY(:,:,:)=MYM(PDYY(:,:,:))
END IF
!
!-------------------------------------------------------------------------------
!
!* 3. COMPUTE PDZX AND PDZY :
! ----------------------
!
PDZX(:,:,:) = DXM(PZZ(:,:,:))
!
PDZY(:,:,:) = DYM(PZZ(:,:,:))
!
!-------------------------------------------------------------------------------
!
!* 4. COMPUTE PDZZ :
! -------------
!
PDZZ(:,:,:) = DZM(MZF(PZZ(:,:,:)))
PDZZ(:,:,IKU) = PZZ(:,:,IKU) - PZZ(:,:,IKU-1) ! same delta z in IKU and IKU -1
PDZZ(:,:,1) = PDZZ(:,:,2) ! same delta z in 1 and 2
!-----------------------------------------------------------------------------
!
END SUBROUTINE METRICS
This diff is collapsed.
This diff is collapsed.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment