sp2gp_gauss4py.F90 Source File


Source Code

SUBROUTINE SP2GP_GAUSS4PY(KRETURNCODE, KSIZEJ, KTRUNC, KNUMMAXRESOL, KGPTOT, KSLOEN, KLOEN, KSIZE, &
                          & LGRADIENT, LREORDER, PSPEC, PGPT, PGPTM, PGPTL)
! ** PURPOSE
!    Transform spectral coefficients into grid-point values
!
! ** DUMMY ARGUMENTS
!    KSIZEJ: Number of latitudes
!    KTRUNC: troncature
!    KNUMMAXRESOL: maximum number of troncatures handled
!    KGPTOT: number of grid-points
!    KSLOEN: Size of KLOEN
!    KLOEN:
!    KSIZE: Size of PSPEC
!    LREORDER: switch to reorder spectral coefficients or not
!    LGRADIENT: switch to compute or not gradient
!    PSPEC: spectral coefficient array
!    PGPT: grid-point field
!    PGPTM: N-S derivative if LGRADIENT
!    PGPTL: E-W derivative if LGRADIENT
!
! ** AUTHOR
!    9 April 2014, S. Riette
!
! ** MODIFICATIONS
!    6 Jan., S. Riette: w_spec_setup interface modified
!    March, 2016, A.Mary: LREORDER
!    Sept., 2016, A.Mary: LGRADIENT
!
! I. Dummy arguments declaration
USE PARKIND1, ONLY : JPRB
IMPLICIT NONE
INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE
INTEGER(KIND=8), INTENT(IN) :: KSIZEJ
INTEGER(KIND=8), INTENT(IN) :: KTRUNC
INTEGER(KIND=8), INTENT(IN) :: KNUMMAXRESOL
INTEGER(KIND=8), INTENT(IN) :: KGPTOT
INTEGER(KIND=8), INTENT(IN) :: KSLOEN
INTEGER(KIND=8), DIMENSION(KSLOEN), INTENT(IN) :: KLOEN
INTEGER(KIND=8), INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LGRADIENT
LOGICAL, INTENT(IN) :: LREORDER
REAL(KIND=8), DIMENSION(KSIZE),  INTENT(IN)  :: PSPEC
REAL(KIND=8), DIMENSION(KGPTOT), INTENT(OUT) :: PGPT
REAL(KIND=8), DIMENSION(KGPTOT), INTENT(OUT) :: PGPTM
REAL(KIND=8), DIMENSION(KGPTOT), INTENT(OUT) :: PGPTL
!
! 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=8), DIMENSION(1, KSIZE) :: ZSPBUF
REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZGPBUF
REAL(KIND=8) :: ZDELTAX, ZDELTAY
#include "trans_inq.h"
#include "inv_trans.h"

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
IF (LREORDER) THEN
  ! 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 Reordering
  IF(.NOT. LLSTOP) THEN
    ZSPBUF(1,:)=0.
    JI=1
    DO JM=0, KTRUNC
      DO JN=JM, KTRUNC
        ZSPBUF(1,JI)=PSPEC(NASM0(JN)+JM)
        JI=JI+1
        IF(JM==0) THEN
          ZSPBUF(1,JI)=0
        ELSE
          ZSPBUF(1,JI)=PSPEC(NASM0(JN)-JM)
        ENDIF
        JI=JI+1
      ENDDO
    ENDDO
  ENDIF
ELSE
  ZSPBUF(1,:) = PSPEC(:)
ENDIF

! IV.c Inverse transform
IF (.NOT. LLSTOP) THEN
  IF (.NOT. LGRADIENT) THEN
    ALLOCATE(ZGPBUF(KGPTOT, 1, 1))
    CALL INV_TRANS(PSPSCALAR=REAL(ZSPBUF(:,:),KIND=JPRB), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL)
    PGPT(:)=REAL(ZGPBUF(:,1,1),KIND=8)
  ELSE
    ALLOCATE(ZGPBUF(KGPTOT, 3, 1))
    CALL INV_TRANS(PSPSCALAR=REAL(ZSPBUF(:,:),KIND=JPRB), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL, LDSCDERS=.TRUE.)
    PGPT(:)=REAL(ZGPBUF(:,1,1),KIND=8)
    PGPTM(:)=REAL(ZGPBUF(:,2,1),KIND=8)
    PGPTL(:)=REAL(ZGPBUF(:,3,1),KIND=8)
  ENDIF
ENDIF
END SUBROUTINE SP2GP_GAUSS4PY