vordiv_to_uv.F90 Source File


This file depends on

sourcefile~~vordiv_to_uv.f90~~EfferentGraph sourcefile~vordiv_to_uv.f90 vordiv_to_uv.F90 sourcefile~abort_trans_mod.f90 abort_trans_mod.F90 sourcefile~vordiv_to_uv.f90->sourcefile~abort_trans_mod.f90 sourcefile~set_resol_mod.f90 set_resol_mod.F90 sourcefile~vordiv_to_uv.f90->sourcefile~set_resol_mod.f90 sourcefile~tpm_distr.f90 tpm_distr.F90 sourcefile~vordiv_to_uv.f90->sourcefile~tpm_distr.f90 sourcefile~tpm_gen.f90 tpm_gen.F90 sourcefile~vordiv_to_uv.f90->sourcefile~tpm_gen.f90 sourcefile~vd2uv_ctl_mod.f90 vd2uv_ctl_mod.F90 sourcefile~vordiv_to_uv.f90->sourcefile~vd2uv_ctl_mod.f90 sourcefile~abort_trans_mod.f90->sourcefile~tpm_distr.f90 sourcefile~abort_trans_mod.f90->sourcefile~tpm_gen.f90 sourcefile~set_resol_mod.f90->sourcefile~abort_trans_mod.f90 sourcefile~set_resol_mod.f90->sourcefile~tpm_distr.f90 sourcefile~set_resol_mod.f90->sourcefile~tpm_gen.f90 sourcefile~tpm_ctl.f90 tpm_ctl.F90 sourcefile~set_resol_mod.f90->sourcefile~tpm_ctl.f90 sourcefile~tpm_dim.f90 tpm_dim.F90 sourcefile~set_resol_mod.f90->sourcefile~tpm_dim.f90 sourcefile~tpm_fft.f90 tpm_fft.F90 sourcefile~set_resol_mod.f90->sourcefile~tpm_fft.f90 sourcefile~tpm_fields.f90 tpm_fields.F90 sourcefile~set_resol_mod.f90->sourcefile~tpm_fields.f90 sourcefile~tpm_flt.f90 tpm_flt.F90 sourcefile~set_resol_mod.f90->sourcefile~tpm_flt.f90 sourcefile~tpm_geometry.f90 tpm_geometry.F90 sourcefile~set_resol_mod.f90->sourcefile~tpm_geometry.f90 sourcefile~tpm_hicfft.f90 tpm_hicfft.F90 sourcefile~set_resol_mod.f90->sourcefile~tpm_hicfft.f90 sourcefile~parkind_ectrans.f90 parkind_ectrans.F90 sourcefile~tpm_gen.f90->sourcefile~parkind_ectrans.f90 sourcefile~vd2uv_ctl_mod.f90->sourcefile~tpm_distr.f90 sourcefile~vd2uv_mod.f90 vd2uv_mod.F90 sourcefile~vd2uv_ctl_mod.f90->sourcefile~vd2uv_mod.f90 sourcefile~sharedmem_mod.f90 sharedmem_mod.F90 sourcefile~tpm_ctl.f90->sourcefile~sharedmem_mod.f90 sourcefile~tpm_fft.f90->sourcefile~parkind_ectrans.f90 sourcefile~tpm_fields.f90->sourcefile~parkind_ectrans.f90 sourcefile~tpm_flt.f90->sourcefile~parkind_ectrans.f90 sourcefile~seefmm_mix.f90 seefmm_mix.F90 sourcefile~tpm_flt.f90->sourcefile~seefmm_mix.f90 sourcefile~tpm_geometry.f90->sourcefile~parkind_ectrans.f90 sourcefile~tpm_hicfft.f90->sourcefile~parkind_ectrans.f90 sourcefile~growing_allocator_mod.f90 growing_allocator_mod.F90 sourcefile~tpm_hicfft.f90->sourcefile~growing_allocator_mod.f90 sourcefile~vd2uv_mod.f90->sourcefile~tpm_distr.f90 sourcefile~vd2uv_mod.f90->sourcefile~parkind_ectrans.f90 sourcefile~vd2uv_mod.f90->sourcefile~tpm_dim.f90 sourcefile~prepsnm_mod.f90 prepsnm_mod.F90 sourcefile~vd2uv_mod.f90->sourcefile~prepsnm_mod.f90 sourcefile~prfi1b_mod.f90 prfi1b_mod.F90 sourcefile~vd2uv_mod.f90->sourcefile~prfi1b_mod.f90 sourcefile~tpm_constants.f90 tpm_constants.F90 sourcefile~vd2uv_mod.f90->sourcefile~tpm_constants.f90 sourcefile~vdtuv_mod.f90 vdtuv_mod.F90 sourcefile~vd2uv_mod.f90->sourcefile~vdtuv_mod.f90 sourcefile~prepsnm_mod.f90->sourcefile~tpm_distr.f90 sourcefile~prepsnm_mod.f90->sourcefile~tpm_gen.f90 sourcefile~prepsnm_mod.f90->sourcefile~parkind_ectrans.f90 sourcefile~prepsnm_mod.f90->sourcefile~tpm_dim.f90 sourcefile~prepsnm_mod.f90->sourcefile~tpm_fields.f90 sourcefile~prfi1b_mod.f90->sourcefile~tpm_distr.f90 sourcefile~prfi1b_mod.f90->sourcefile~tpm_dim.f90 sourcefile~seefmm_mix.f90->sourcefile~parkind_ectrans.f90 sourcefile~wts500_mod.f90 wts500_mod.F90 sourcefile~seefmm_mix.f90->sourcefile~wts500_mod.f90 sourcefile~tpm_constants.f90->sourcefile~parkind_ectrans.f90 sourcefile~vdtuv_mod.f90->sourcefile~tpm_distr.f90 sourcefile~vdtuv_mod.f90->sourcefile~tpm_gen.f90 sourcefile~vdtuv_mod.f90->sourcefile~parkind_ectrans.f90 sourcefile~vdtuv_mod.f90->sourcefile~tpm_dim.f90 sourcefile~vdtuv_mod.f90->sourcefile~tpm_fields.f90 sourcefile~wts500_mod.f90->sourcefile~parkind_ectrans.f90

Source Code

! (C) Copyright 2015- ECMWF.
! (C) Copyright 2015- Meteo-France.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!

SUBROUTINE VORDIV_TO_UV(PSPVOR,PSPDIV,PSPU,PSPV,KSMAX,KVSETUV)

!**** *VORDIV_TO_UV* - Convert spectral vorticity and divergence to spectral U (u*cos(theta)) and V (v*cos(theta).

!     Purpose.
!     --------
!        Interface routine for  Convert spectral vorticity and divergence to spectral U  and V 

!**   Interface.
!     ----------
!     CALL VORDIV_TO_UV(...)

!     Explicit arguments :
!     --------------------
!     PSPVOR(:,:) - spectral vorticity (input)
!     PSPDIV(:,:) - spectral divergence (input)
!     PSPU(:,:)   - spectral U (u*cos(theta) (output)
!     PSPV(:,:)   - spectral V (v*cos(theta) (output)
!     KSMAX       - spectral resolution (input)
!     KVSETUV(:)  - Optionally indicating which 'b-set' in spectral space owns a
!                   vor/div field. Equivalant to NBSETLEV in the IFS.
!                   The length of KVSETUV should be the GLOBAL number
!                   of u/v fields which is the dimension of u and v releated
!                   fields in grid-point space.

!     Method.
!     -------

!     Externals.  SET_RESOL   - set resolution
!     ----------  VD2UV_CTL   - control vordiv to uv

!     Author.
!     -------
!        Mats Hamrud *ECMWF*

!     Modifications.
!     --------------
!        Original : 15-06-15


!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB

!ifndef INTERFACE

USE TPM_GEN         ,ONLY : NERR, MSETUP0
USE TPM_DISTR       ,ONLY : NPRTRV, MYSETV

USE SET_RESOL_MOD   ,ONLY : SET_RESOL
USE VD2UV_CTL_MOD ,ONLY   : VD2UV_CTL
USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK, JPHOOK

!endif INTERFACE

IMPLICIT NONE

! Declaration of arguments

REAL(KIND=JPRB), INTENT(IN) :: PSPVOR(:,:)
REAL(KIND=JPRB), INTENT(IN) :: PSPDIV(:,:)
REAL(KIND=JPRB), INTENT(OUT) :: PSPU(:,:)
REAL(KIND=JPRB), INTENT(OUT) :: PSPV(:,:)
INTEGER(KIND=JPIM) , INTENT(IN) :: KSMAX
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:)

!ifndef INTERFACE

! Local variables
INTEGER(KIND=JPIM) :: J
INTEGER(KIND=JPIM) :: IF_UV,IF_UV_G,IRESOL,IDGL
LOGICAL :: LTMP_SETUP0
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

#include "setup_trans0.h"
#include "setup_trans.h"
#include "trans_release.h"
#include "trans_end.h"

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('VORDIV_TO_UV',0,ZHOOK_HANDLE)

!CALL GSTATS(XXXX,0)

IF(MSETUP0 == 0) THEN
  CALL SETUP_TRANS0()
  LTMP_SETUP0 = .TRUE.
ELSE
  LTMP_SETUP0 = .FALSE.
ENDIF
IDGL = 2 ! It doesn't matter as long as it's a positive even number
CALL SETUP_TRANS(KSMAX,IDGL,LDSPSETUPONLY=.TRUE.,KRESOL=IRESOL)
CALL SET_RESOL(IRESOL)


! Set defaults

IF_UV = 0
IF_UV_G = 0
! Decide requirements

IF(PRESENT(KVSETUV)) THEN
  IF_UV_G = UBOUND(KVSETUV,1)
  DO J=1,IF_UV_G
    IF(KVSETUV(J) > NPRTRV .OR. KVSETUV(J) < 1) THEN
      WRITE(NERR,*) 'VORDIV_TO_UV:KVSETUV(J) > NPRTRV ',J,KVSETUV(J),NPRTRV
      CALL ABORT_TRANS('VORDIV_TO_UV:KVSETUV TOO LONG OR CONTAINS VALUES OUTSIDE RANGE')
    ENDIF
    IF(KVSETUV(J) == MYSETV) THEN
      IF_UV = IF_UV+1
    ENDIF
  ENDDO
ELSE
  IF_UV = UBOUND(PSPVOR,1)
  IF_UV_G = IF_UV
ENDIF

! Consistency checks

IF (IF_UV > 0) THEN
  IF(UBOUND(PSPVOR,1) < IF_UV) THEN
    WRITE(NERR,*)'VORDIV_TO_UV : UBOUND(PSPVOR,1) < IF_UV ',UBOUND(PSPVOR,1),IF_UV
    CALL ABORT_TRANS('VORDIV_TO_UV : PSPVOR TOO SHORT')
  ENDIF
  IF(UBOUND(PSPDIV,1) < IF_UV) THEN
    WRITE(NERR,*)'VORDIV_TO_UV : UBOUND(PSPDIV,1) < IF_UV ',UBOUND(PSPDIV,1),IF_UV
    CALL ABORT_TRANS('VORDIV_TO_UV : PSPDIV TOO SHORT')
  ENDIF
  IF(UBOUND(PSPU,1) < IF_UV) THEN
    WRITE(NERR,*)'VORDIV_TO_UV : UBOUND(PSPU,1) < IF_UV ',UBOUND(PSPU,1),IF_UV
    CALL ABORT_TRANS('VORDIV_TO_UV : PSPU TOO SHORT')
  ENDIF
  IF(UBOUND(PSPV,1) < IF_UV) THEN
    WRITE(NERR,*)'VORDIV_TO_UV : UBOUND(PSPV,1) < IF_UV ',UBOUND(PSPV,1),IF_UV
    CALL ABORT_TRANS('VORDIV_TO_UV : PSPV TOO SHORT')
  ENDIF
ENDIF


IF(NPRTRV >1) THEN
  IF(IF_UV > 0 .AND. .NOT. PRESENT(KVSETUV)) THEN
    WRITE(NERR,*)'NPRTRV >1 AND IF_UV > 0 AND NOT PRESENT(KVSETUV)',&
                 &NPRTRV,IF_UV
    CALL ABORT_TRANS('VORDIV_TO_UV: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!')
  ENDIF
ENDIF

!CALL GSTATS(XXXX,1)

!     ------------------------------------------------------------------

! Perform transform

CALL VD2UV_CTL(IF_UV,PSPVOR,PSPDIV,PSPU,PSPV)

CALL TRANS_RELEASE(IRESOL)
IF (LTMP_SETUP0) THEN
  CALL TRANS_END()
ENDIF

IF (LHOOK) CALL DR_HOOK('VORDIV_TO_UV',1,ZHOOK_HANDLE)
!     ------------------------------------------------------------------

!endif INTERFACE

END SUBROUTINE VORDIV_TO_UV