spec_setup4py.F90 Source File


Source Code

SUBROUTINE SPEC_SETUP4PY(KRETURNCODE, KSIZEI, KSIZEJ, KPHYSICALSIZEI, KPHYSICALSIZEJ, &
                       &KTRUNCX, KTRUNCY, KNUMMAXRESOL, KLOEN, LDLAM, &
                       &KSIZEKLOEN, PDELTAX, PDELTAY, &
                       &KIDENTRESOL, LDSTOP)
! ** PURPOSE
!    Setup spectral transform for LAM and global
!
! ** DUMMY ARGUMENTS
!    KRETURNCODE: error code
!    KSIZEI, KSIZEJ: size of grid-point field (with extension zone for LAM), put max size for KSIZEI in global
!    KPHYSICALSIZEI, KPHYSICALSIZEJ: size of physical part of grid-point field for LAM (put 0 for global)
!    KTRUNCX, KTRUNCY: troncatures for LAM (only KTRUNCX is used for global, put 0 for KTRUNCY)
!    KNUMMAXRESOL: maximum number of troncatures handled
!    KLOEN: number of points on each latitude row
!    KSIZEKLOEN: size of KLOEN array
!    PDELTAX: x resolution
!    PDELTAY: y resolution
!    LDLAM: LAM (.TRUE.) or global (.FALSE.)
!    KIDENTRESOL: identification of resolution
!    LDSTOP: exception raised?
!
! ** AUTHOR
!    9 April 2014, S. Riette
!
! ** MODIFICATIONS
!    6 Jan 2016, S. Riette: PDELTAX and PDELTAY added
!    31 Jan 2019 R. El Khatib fix for single precision compilation
!
! I. Dummy arguments declaration
USE PARKIND1, ONLY : JPRB
IMPLICIT NONE
INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE
INTEGER, INTENT(IN) :: KSIZEI, KSIZEJ
INTEGER, INTENT(IN) :: KPHYSICALSIZEI, KPHYSICALSIZEJ
INTEGER, INTENT(IN) :: KTRUNCX, KTRUNCY
INTEGER, INTENT(IN) :: KNUMMAXRESOL
INTEGER, DIMENSION(KSIZEKLOEN), INTENT(IN) :: KLOEN
LOGICAL, INTENT(IN) :: LDLAM
INTEGER, INTENT(IN) :: KSIZEKLOEN
REAL(KIND=8), INTENT(IN) :: PDELTAX
REAL(KIND=8), INTENT(IN) :: PDELTAY
INTEGER, INTENT(OUT) :: KIDENTRESOL
LOGICAL, INTENT(OUT) :: LDSTOP
!
! II. Local variables declaration
INTEGER, DIMENSION(2*KSIZEJ) :: ILOEN
INTEGER :: JI
LOGICAL, SAVE :: LLFIRSTCALL=.TRUE.
LOGICAL :: LLNEWRESOL
INTEGER, SAVE :: INBRESOL=0
INTEGER(KIND=8) :: ICODEILOEN
INTEGER, SAVE :: INUMMAXRESOLSAVE=-1
INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: ITRUNCXSAVE, ITRUNCYSAVE, &
                                            IPHYSICALSIZEISAVE, &
                                            IPHYSICALSIZEJSAVE, &
                                            ISIZEISAVE, ISIZEJSAVE, &
                                            IIDENTRESOLSAVE
INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE, SAVE :: ILOENSAVE
REAL(KIND=8), DIMENSION(:), ALLOCATABLE, SAVE :: ZDELTAXSAVE, &
                                                        ZDELTAYSAVE
REAL(KIND=8) :: ZEXWN, ZEYWN

#include "setup_trans0.h"
#include "esetup_trans.h"
#include "setup_trans.h"

KRETURNCODE=0
LDSTOP=.FALSE.
! III. Setup

! III.a Setup LAM and global spectral transform - all resolutions
! Maximum number of resolution is set now and cannot be change anymore
IF (LLFIRSTCALL) THEN
  !This code is called only once, whatever is the number of resolutions
  CALL SETUP_TRANS0(KPRINTLEV=0, LDMPOFF=.TRUE., KMAX_RESOL=KNUMMAXRESOL)
  ALLOCATE(ITRUNCXSAVE(KNUMMAXRESOL))
  ALLOCATE(ITRUNCYSAVE(KNUMMAXRESOL))
  ALLOCATE(IPHYSICALSIZEISAVE(KNUMMAXRESOL))
  ALLOCATE(IPHYSICALSIZEJSAVE(KNUMMAXRESOL))
  ALLOCATE(ISIZEJSAVE(KNUMMAXRESOL))
  ALLOCATE(ISIZEISAVE(KNUMMAXRESOL))
  ALLOCATE(ILOENSAVE(KNUMMAXRESOL))
  ALLOCATE(IIDENTRESOLSAVE(KNUMMAXRESOL))
  ALLOCATE(ZDELTAXSAVE(KNUMMAXRESOL))
  ALLOCATE(ZDELTAYSAVE(KNUMMAXRESOL))
  ITRUNCXSAVE=-1
  ITRUNCYSAVE=-1
  IPHYSICALSIZEISAVE=-1
  IPHYSICALSIZEJSAVE=-1
  ISIZEJSAVE=-1
  ISIZEISAVE=-1
  ILOENSAVE=-1
  IIDENTRESOLSAVE=-1
  ZDELTAXSAVE=-1.
  ZDELTAXSAVE=-1.
  LLFIRSTCALL=.FALSE.
  INUMMAXRESOLSAVE=KNUMMAXRESOL
ENDIF
!
! III.b Is-it a new resolution?
LLNEWRESOL=.TRUE.
IF(LDLAM) THEN
  ILOEN(:)=KSIZEI
ELSE
  ILOEN(:)=0
  ILOEN(1:MIN(SIZE(ILOEN),SIZE(KLOEN)))=KLOEN(1:MIN(SIZE(ILOEN),SIZE(KLOEN)))
ENDIF
ICODEILOEN=0
DO JI=1, SIZE(ILOEN)
  ICODEILOEN=ICODEILOEN+ILOEN(JI)*JI**4
ENDDO
DO JI=1, INBRESOL
  IF (KTRUNCX==ITRUNCXSAVE(JI) .AND. KTRUNCY==ITRUNCYSAVE(JI) .AND. &
   &KPHYSICALSIZEI==IPHYSICALSIZEISAVE(JI) .AND. &
   &KPHYSICALSIZEJ==IPHYSICALSIZEJSAVE(JI) .AND. &
   &KSIZEJ==ISIZEJSAVE(JI) .AND. KSIZEI==ISIZEISAVE(JI) .AND. &
   &ICODEILOEN==ILOENSAVE(JI) .AND. &
   &PDELTAX==ZDELTAXSAVE(JI) .AND. PDELTAY==ZDELTAYSAVE(JI)) THEN
    KIDENTRESOL=IIDENTRESOLSAVE(JI)
    LLNEWRESOL=.FALSE.
  ENDIF
ENDDO
IF(LLNEWRESOL) THEN
  INBRESOL=INBRESOL+1
  IF(INBRESOL>INUMMAXRESOLSAVE) THEN
    PRINT*, "Error in SPEC_SETUP4PY : Maximum number of resolution is exceeded."
    KRETURNCODE=-999
    LDSTOP=.TRUE.
  ENDIF
ENDIF
!
! III.c Setup LAM or global spectral transform - once by resolution
IF(LLNEWRESOL .AND. .NOT. LDSTOP) THEN
  ! The following code is exectuded once for each resolution
  ITRUNCXSAVE(INBRESOL)=KTRUNCX
  ITRUNCYSAVE(INBRESOL)=KTRUNCY
  IPHYSICALSIZEISAVE(INBRESOL)=KPHYSICALSIZEI
  IPHYSICALSIZEJSAVE(INBRESOL)=KPHYSICALSIZEJ
  ISIZEISAVE(INBRESOL)=KSIZEI
  ISIZEJSAVE(INBRESOL)=KSIZEJ
  ILOENSAVE(INBRESOL)=ICODEILOEN
  ZDELTAXSAVE(INBRESOL)=PDELTAX
  ZDELTAYSAVE(INBRESOL)=PDELTAY
  IF(LDLAM) THEN
    ZEXWN=2*3.141592653589797/(KSIZEI*PDELTAX)
    ZEYWN=2*3.141592653589797/(KSIZEJ*PDELTAY)
    CALL ESETUP_TRANS(KMSMAX=ITRUNCXSAVE(INBRESOL), KSMAX=ITRUNCYSAVE(INBRESOL), &
                     &KDGUX=IPHYSICALSIZEJSAVE(INBRESOL), &
                     &KDGL=ISIZEJSAVE(INBRESOL), KLOEN=ILOEN(:), KRESOL=IIDENTRESOLSAVE(INBRESOL), &
                     &PEXWN=REAL(ZEXWN,KIND=JPRB), PEYWN=REAL(ZEYWN,KIND=JPRB))
  ELSE
    PRINT*, "Setup spectral transform"
    CALL SETUP_TRANS(KSMAX=ITRUNCXSAVE(INBRESOL), KDGL=ISIZEJSAVE(INBRESOL), &
                    &KLOEN=ILOEN(1:ISIZEJSAVE(INBRESOL)), KRESOL=IIDENTRESOLSAVE(INBRESOL))
    PRINT*, "End Setup spectral transform"
  ENDIF
  KIDENTRESOL=IIDENTRESOLSAVE(INBRESOL)
ENDIF
END SUBROUTINE SPEC_SETUP4PY