gp2sp_gauss4py.F90 Source File

SUBROUTINE GP2SP_GAUSS4PY(KRETURNCODE, KSPEC, KSIZEJ, KTRUNC, KNUMMAXRESOL, KSLOEN, KLOEN, KSIZE, LREORDER, PGPT, PSPEC)
! ** PURPOSE
!    Transform spectral coefficients into grid-point values
!
! ** DUMMY ARGUMENTS
!    KRETURNCODE: error code
!    KSPEC: size of spectral coefficients array
!    KSIZEJ: Number of latitudes
!    KTRUNC: troncature
!    KNUMMAXRESOL: maximum number of troncatures handled
!    KSLOEN: Size ok KLOEN
!    KLOEN
!    KSIZE: Size of PGPT
!    LREORDER: switch to reorder spectral coefficients or not
!    PGPT: grid-point field
!    PSPEC: spectral coefficient array
!
! ** AUTHOR
!    9 April 2014, S. Riette
!
! ** MODIFICATIONS
!    6 Jan. 2016, S. Riette: w_spec_setup interface modified
!    March, 2016, A.Mary: LREORDER
!
! I. Dummy arguments declaration
USE PARKIND1, ONLY : JPRB
IMPLICIT NONE
INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE
INTEGER(KIND=8), INTENT(IN) :: KSPEC
INTEGER(KIND=8), INTENT(IN) :: KSIZEJ
INTEGER(KIND=8), INTENT(IN) :: KTRUNC
INTEGER(KIND=8), INTENT(IN) :: KNUMMAXRESOL
INTEGER(KIND=8), INTENT(IN) :: KSLOEN
INTEGER(KIND=8), DIMENSION(KSLOEN), INTENT(IN) :: KLOEN
INTEGER(KIND=8), INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LREORDER
REAL(KIND=8), DIMENSION(KSIZE), INTENT(IN) :: PGPT
REAL(KIND=8), DIMENSION(KSPEC), INTENT(OUT) :: PSPEC
!
! II. Local variables declaration
INTEGER, DIMENSION(SIZE(KLOEN)) :: ILOEN
INTEGER :: ISIZEI, ISIZEJ, &
         & IPHYSICALSIZEI, IPHYSICALSIZEJ, &
         & ITRUNCX, ITRUNCY, &
         & INUMMAXRESOL
LOGICAL :: LLSTOP
INTEGER :: IIDENTRESOL
INTEGER :: JI, JM, JN
INTEGER, DIMENSION(0:KTRUNC) :: NASM0
REAL(KIND=JPRB), DIMENSION(1, SIZE(PGPT)) :: ZSPBUF !size over-evaluated
REAL(KIND=JPRB), DIMENSION(SIZE(PGPT), 1, 1) :: ZGPBUF
REAL(KIND=8) :: ZDELTAX, ZDELTAY

#include "trans_inq.h"
#include "dir_trans.h"
KRETURNCODE=0
ILOEN(:)=KLOEN(:)
ISIZEI=0
ISIZEJ=KSIZEJ
IPHYSICALSIZEI=0
IPHYSICALSIZEJ=0
ITRUNCX=KTRUNC
ITRUNCY=0
INUMMAXRESOL=KNUMMAXRESOL
!
! III. Setup
ZDELTAX=0.
ZDELTAY=0.
CALL SPEC_SETUP4PY(KRETURNCODE, ISIZEI, ISIZEJ, IPHYSICALSIZEI, IPHYSICALSIZEJ, &
                  &ITRUNCX, ITRUNCY, INUMMAXRESOL, ILOEN, .FALSE., SIZE(ILOEN), &
                  &ZDELTAX, ZDELTAY, IIDENTRESOL, LLSTOP)
!
! IV. Transformation
! IV.a Shape of coefficient array
IF (.NOT. LLSTOP) THEN
  JI=1
  DO JN=0, KTRUNC
    NASM0(JN)=JI
    JI=JI+1+JN+(JN+1)
  ENDDO
ENDIF

! IV.b Direct transform
IF (.NOT. LLSTOP) THEN
  ZGPBUF(:,1,1)=REAL(PGPT(:),KIND=JPRB)
  CALL DIR_TRANS(PSPSCALAR=ZSPBUF(:,:), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL)
ENDIF

! IV.c Reordering
IF (LREORDER) THEN
  IF(.NOT. LLSTOP) THEN
    PSPEC(:)=0.
    JI=1
    DO JM=0, KTRUNC
      DO JN=JM, KTRUNC
        PSPEC(NASM0(JN)+JM)=REAL(ZSPBUF(1,JI),KIND=8)
        JI=JI+1
        IF(JM/=0) THEN
          PSPEC(NASM0(JN)-JM)=REAL(ZSPBUF(1,JI),KIND=8)
        ENDIF
        JI=JI+1
      ENDDO
    ENDDO
    IF(JI-1/=KSPEC) THEN
      PRINT*, "Internal error in GP2SP_GAUSS4PY (spectral reordering)"
      KRETURNCODE=-999
    ENDIF
  ENDIF
ELSE
  PSPEC(1:KSPEC) = REAL(ZSPBUF(1,1:KSPEC),KIND=8)
ENDIF

END SUBROUTINE GP2SP_GAUSS4PY