set_resol_mod.F90 Source File

! (C) Copyright 2000- ECMWF.
! (C) Copyright 2000- Meteo-France.
! (C) Copyright 2022- NVIDIA.
! 
! 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.
!

MODULE SET_RESOL_MOD
CONTAINS
SUBROUTINE SET_RESOL(KRESOL,LDSETUP)
USE PARKIND1        ,ONLY : JPIM

USE TPM_GEN         ,ONLY : NOUT, MSETUP0, NCUR_RESOL, NMAX_RESOL,LENABLED
USE TPM_DIM         ,ONLY : R, DIM_RESOL
!USE TPM_TRANS
USE TPM_DISTR       ,ONLY : D, DISTR_RESOL
USE TPM_GEOMETRY    ,ONLY : G, GEOM_RESOL
USE TPM_FIELDS      ,ONLY : F, FIELDS_RESOL
USE TPM_FFT         ,ONLY : T, FFT_RESOL
USE TPM_HICFFT      ,ONLY : HICT, HICFFT_RESOL
USE TPM_FLT
USE TPM_CTL         ,ONLY : C, CTL_RESOL
USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS
!

IMPLICIT NONE

! Declaration of arguments

INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL
LOGICAL            ,OPTIONAL, INTENT(IN) :: LDSETUP

! Local varaibles
INTEGER(KIND=JPIM) :: IRESOL
LOGICAL :: LLSETUP

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

IF(MSETUP0 == 0) CALL ABORT_TRANS('SET_RESOL:TRANS NOT SETUP')
LLSETUP = .FALSE.
IF(PRESENT(LDSETUP)) LLSETUP = LDSETUP
IRESOL = 1
IF(PRESENT(KRESOL)) THEN
  IRESOL = KRESOL
 IF(IRESOL < 1 .OR. IRESOL > NMAX_RESOL) THEN
   WRITE(NOUT,*)'SET_RESOL: UNKNOWN RESOLUTION ',IRESOL,NMAX_RESOL
   CALL ABORT_TRANS('SET_RESOL:IRESOL < 1 .OR. KRESOL > NMAX_RESOL')
  ENDIF
  IF(.NOT.LLSETUP) THEN
    IF(.NOT.LENABLED(IRESOL)) THEN
      WRITE(NOUT,*)'SET_RESOL: UNKNOWN RESOLUTION ',IRESOL,LENABLED
      CALL ABORT_TRANS('SET_RESOL:IRESOL NOT ENABLED')
     ENDIF
   ENDIF
ENDIF
IF(IRESOL /= NCUR_RESOL) THEN
  NCUR_RESOL = IRESOL
  R => DIM_RESOL(NCUR_RESOL)
  F => FIELDS_RESOL(NCUR_RESOL)
  G => GEOM_RESOL(NCUR_RESOL)
  D => DISTR_RESOL(NCUR_RESOL)
  T => FFT_RESOL(NCUR_RESOL)
  HICT => HICFFT_RESOL(NCUR_RESOL)
  S => FLT_RESOL(NCUR_RESOL)
  C => CTL_RESOL(NCUR_RESOL)
ENDIF

END SUBROUTINE SET_RESOL
END MODULE SET_RESOL_MOD