trans_inq.F90

Go to the documentation of this file.

SUBROUTINE trans_inq(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,&
                    &kgptot,kgptotg,kgptotmx,kgptotl,&
                    &kmyms,kasm0,kumpp,kpossp,kptrms,kallms,kdim0g,&
                    &kfrstlat,klstlat,kfrstloff,kptrlat,&
                    &kptrfrstlat,kptrlstlat,kptrfloff,ksta,konl,&
                    &kultpp,kptrls,&
                    &ldsplitlat,&
                    &pmu,pgw,prpnm,klei3,kspolegl,kpms)

!**** *TRANS_INQ* - Extract information from the transform package

!     Purpose.
!     --------
!     Interface routine for extracting information from the T.P.

!**   Interface.
!     ----------
!     CALL TRANS_INQ(...)
!     Explicit arguments : All arguments are optional.
!     -------------------- 
!     KRESOL   - resolution tag for which info is required ,default is the
!                first defined resulution (input)

!                   SPECTRAL SPACE
!     KSPEC    - number of complex spectral coefficients on this PE
!     KSPEC2   - 2*KSPEC 
!     KSPEC2G  - global KSPEC2
!     KSPEC2MX - maximun KSPEC2 among all PEs
!     KNUMP    - Number of spectral waves handled by this PE
!     KGPTOT   - Total number of grid columns on this PE
!     KGPTOTG  - Total number of grid columns on the Globe
!     KGPTOTMX - Maximum number of grid columns on any of the PEs
!     KGPTOTL  - Number of grid columns one each PE (dimension N_REGIONS_NS:N_REGIONS_EW)
!     KMYMS    - This PEs spectral zonal wavenumbers
!     KASM0    - Address in a spectral array of (m, n=m)
!     KUMPP    - No. of wave numbers each wave set is responsible for
!     KPOSSP   - Defines partitioning of global spectral fields among PEs
!     KPTRMS   - Pointer to the first wave number of a given a-set
!     KALLMS   - Wave numbers for all wave-set concatenated together 
!                to give all wave numbers in wave-set order
!     KDIM0G   - Defines partitioning of global spectral fields among PEs

!                 GRIDPOINT SPACE                  
!     KFRSTLAT    - First latitude of each a-set in grid-point space
!     KLSTTLAT    - Last latitude of each a-set in grid-point space
!     KFRSTLOFF   - Offset for first lat of own a-set in grid-point space
!     KPTRLAT     - Pointer to the start of each latitude
!     KPTRFRSTLAT - Pointer to the first latitude of each a-set in 
!                   NSTA and NONL arrays
!     KPTRLSTLAT  - Pointer to the last latitude of each a-set in
!                   NSTA and NONL arrays
!     KPTRFLOFF   - Offset for pointer to the first latitude of own a-set
!                   NSTA and NONL arrays, i.e. nptrfrstlat(myseta)-1
!     KSTA        - Position of first grid column for the latitudes on a 
!                   processor. The information is available for all processors.
!                   The b-sets are distinguished by the last dimension of 
!                   nsta().The latitude band for each a-set is addressed by 
!                   nptrfrstlat(jaset),nptrlstlat(jaset), and 
!                   nptrfloff=nptrfrstlat(myseta) on this processors a-set.
!                   Each split latitude has two entries in nsta(,:) which 
!                   necessitates the rather complex addressing of nsta(,:)
!                   and the overdimensioning of nsta by N_REGIONS_NS.
!     KONL        - Number of grid columns for the latitudes on a processor.
!                   Similar to nsta() in data structure.
!     LDSPLITLAT  - TRUE if latitude is split in grid point space over 
!                   two a-sets

!                FOURIER SPACE
!     KULTPP   - number of latitudes for which each a-set is calculating 
!                the FFT's.
!     KPTRLS   - pointer to first global latitude of each a-set for which
!                it performs the Fourier calculations

!                 LEGENDRE
!     PMU      - sin(Gaussian latitudes)
!     PGW      - Gaussian weights
!     PRPNM    - Legendre polynomials
!     KLEI3    - First dimension of Legendre polynomials
!     KSPOLEGL - Second dimension of Legendre polynomials
!     KPMS     - Adress for legendre polynomial for given M (NSMAX)

!     Method.
!     -------

!     Externals.  SET_RESOL - set resolution
!     ----------  

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

!     Modifications.
!     --------------
!        Original : 00-03-03
!        M. Hortal : 2001-03-05 Dimensions of the Legendre polynomials

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

USE parkind1  ,ONLY : jpim     ,jprb

!ifndef INTERFACE

USE tpm_gen
USE tpm_dim
USE tpm_distr
USE tpm_geometry
USE tpm_fields

USE set_resol_mod
USE abort_trans_mod
USE eq_regions_mod

!endif INTERFACE

IMPLICIT NONE

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

INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2G
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2MX
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNUMP
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOT
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTG
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTMX
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTL(:,:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLOFF
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFLOFF

INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYMS(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KASM0(0:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KUMPP(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPOSSP(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRMS(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KALLMS(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KDIM0G(0:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLAT(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLSTLAT(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLAT(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFRSTLAT(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLSTLAT(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSTA(:,:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KONL(:,:)
LOGICAL   ,OPTIONAL, INTENT(OUT) :: LDSPLITLAT(:)

INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KULTPP(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLS(:)

REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PMU(:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PGW(:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PRPNM(:,:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLEI3
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPOLEGL
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPMS(0:)

!ifndef INTERFACE

INTEGER(KIND=JPIM) :: IU1,IU2
!     ------------------------------------------------------------------


! Set current resolution
CALL set_resol(kresol)

IF(PRESENT(kspec))     kspec     = d%NSPEC
IF(PRESENT(kspec2))    kspec2    = d%NSPEC2
IF(PRESENT(kspec2g))   kspec2g   = r%NSPEC2_G
IF(PRESENT(kspec2mx))  kspec2mx  = d%NSPEC2MX
IF(PRESENT(knump))     knump     = d%NUMP
IF(PRESENT(kgptot))    kgptot    = d%NGPTOT
IF(PRESENT(kgptotg))   kgptotg   = d%NGPTOTG
IF(PRESENT(kgptotmx))  kgptotmx  = d%NGPTOTMX
IF(PRESENT(kfrstloff)) kfrstloff = d%NFRSTLOFF
IF(PRESENT(kptrfloff)) kptrfloff = d%NPTRFLOFF

IF(PRESENT(kgptotl)) THEN
  IF(ubound(kgptotl,1) < n_regions_ns) THEN
    CALL abort_trans('TRANS_INQ: KGPTOTL DIM 1 TOO SMALL')
  ELSEIF(ubound(kgptotl,2) <  n_regions_ew) THEN
    CALL abort_trans('TRANS_INQ: KGPTOTL DIM 2 TOO SMALL')
  ELSE
    kgptotl(1:n_regions_ns,1:n_regions_ew) = d%NGPTOTL(:,:)
  ENDIF
ENDIF

IF(PRESENT(kmyms)) THEN
  IF(ubound(kmyms,1) < d%NUMP) THEN
    CALL abort_trans('TRANS_INQ: KMYMS TOO SMALL')
  ELSE
    kmyms(1:d%NUMP) = d%MYMS(:)
  ENDIF
ENDIF

IF(PRESENT(kasm0)) THEN
  IF(ubound(kasm0,1) < r%NSMAX) THEN
    CALL abort_trans('TRANS_INQ: KASM0 TOO SMALL')
  ELSE
    kasm0(0:r%NSMAX) = d%NASM0(:)
  ENDIF
ENDIF

IF(PRESENT(kumpp)) THEN
  IF(ubound(kumpp,1) < nprtrw) THEN
    CALL abort_trans('TRANS_INQ: KUMPP TOO SMALL')
  ELSE
    kumpp(1:nprtrw) = d%NUMPP(:)
  ENDIF
ENDIF

IF(PRESENT(kpossp)) THEN
  IF(ubound(kpossp,1) < nprtrw+1) THEN
    CALL abort_trans('TRANS_INQ: KPOSSP TOO SMALL')
  ELSE
    kpossp(1:nprtrw+1) = d%NPOSSP(:)
  ENDIF
ENDIF

IF(PRESENT(kptrms)) THEN
  IF(ubound(kptrms,1) < nprtrw) THEN
    CALL abort_trans('TRANS_INQ: KPTRMS TOO SMALL')
  ELSE
    kptrms(1:nprtrw) = d%NPTRMS(:)
  ENDIF
ENDIF

IF(PRESENT(kallms)) THEN
  IF(ubound(kallms,1) < r%NSMAX+1) THEN
    CALL abort_trans('TRANS_INQ: KALLMS TOO SMALL')
  ELSE
    kallms(1:r%NSMAX+1) = d%NALLMS(:)
  ENDIF
ENDIF

IF(PRESENT(kdim0g)) THEN
  IF(ubound(kdim0g,1) < r%NSMAX) THEN
    CALL abort_trans('TRANS_INQ: KDIM0G TOO SMALL')
  ELSE
    kdim0g(0:r%NSMAX) = d%NDIM0G(0:r%NSMAX)
  ENDIF
ENDIF

IF(PRESENT(kfrstlat)) THEN
  IF(ubound(kfrstlat,1) < n_regions_ns) THEN
    CALL abort_trans('TRANS_INQ: KFRSTLAT TOO SMALL')
  ELSE
    kfrstlat(1:n_regions_ns) = d%NFRSTLAT(:)
  ENDIF
ENDIF

IF(PRESENT(klstlat)) THEN
  IF(ubound(klstlat,1) < n_regions_ns) THEN
    CALL abort_trans('TRANS_INQ: KLSTLAT TOO SMALL')
  ELSE
    klstlat(1:n_regions_ns) = d%NLSTLAT(:)
  ENDIF
ENDIF

IF(PRESENT(kptrlat)) THEN
  IF(ubound(kptrlat,1) < r%NDGL) THEN
    CALL abort_trans('TRANS_INQ: KPTRLAT TOO SMALL')
  ELSE
    kptrlat(1:r%NDGL) = d%NPTRLAT(:)
  ENDIF
ENDIF

IF(PRESENT(kptrfrstlat)) THEN
  IF(ubound(kptrfrstlat,1) < n_regions_ns) THEN
    CALL abort_trans('TRANS_INQ: KPTRFRSTLAT TOO SMALL')
  ELSE
    kptrfrstlat(1:n_regions_ns) = d%NPTRFRSTLAT(:)
  ENDIF
ENDIF

IF(PRESENT(kptrlstlat)) THEN
  IF(ubound(kptrlstlat,1) < n_regions_ns) THEN
    CALL abort_trans('TRANS_INQ: KPTRLSTLAT TOO SMALL')
  ELSE
    kptrlstlat(1:n_regions_ns) = d%NPTRLSTLAT(:)
  ENDIF
ENDIF

IF(PRESENT(ksta)) THEN
  IF(ubound(ksta,1) < r%NDGL+n_regions_ns-1) THEN
    CALL abort_trans('TRANS_INQ: KSTA DIM 1 TOO SMALL')
  ELSEIF(ubound(ksta,2) < n_regions_ew) THEN
    CALL abort_trans('TRANS_INQ: KSTA DIM 2 TOO SMALL')
  ELSE
    ksta(1:r%NDGL+n_regions_ns-1,1:n_regions_ew) = d%NSTA(:,:)
  ENDIF
ENDIF

IF(PRESENT(konl)) THEN
  IF(ubound(konl,1) < r%NDGL+n_regions_ns-1) THEN
    CALL abort_trans('TRANS_INQ: KONL DIM 1 TOO SMALL')
  ELSEIF(ubound(konl,2) < n_regions_ew) THEN
    CALL abort_trans('TRANS_INQ: KONL DIM 2 TOO SMALL')
  ELSE
    konl(1:r%NDGL+n_regions_ns-1,1:n_regions_ew) = d%NONL(:,:)
  ENDIF
ENDIF

IF(PRESENT(ldsplitlat)) THEN
  IF(ubound(ldsplitlat,1) < r%NDGL) THEN
    CALL abort_trans('TRANS_INQ: LDSPLITLAT TOO SMALL')
  ELSE
    ldsplitlat(1:r%NDGL) = d%LSPLITLAT(:)
  ENDIF
ENDIF

IF(PRESENT(kultpp)) THEN
  IF(ubound(kultpp,1) < nprtrns) THEN
    CALL abort_trans('TRANS_INQ: KULTPP TOO SMALL')
  ELSE
    kultpp(1:nprtrns) = d%NULTPP(:)
  ENDIF
ENDIF

IF(PRESENT(kptrls)) THEN
  IF(ubound(kptrls,1) < nprtrns) THEN
    CALL abort_trans('TRANS_INQ: KPTRLS TOO SMALL')
  ELSE
    kptrls(1:nprtrns) = d%NPTRLS(:)
  ENDIF
ENDIF

IF(PRESENT(pmu)) THEN
  IF(ubound(pmu,1) < r%NDGL) THEN
    CALL abort_trans('TRANS_INQ: PMU TOO SMALL')
  ELSE
    pmu(1:r%NDGL) = f%RMU
  ENDIF
ENDIF

IF(PRESENT(pgw)) THEN
  IF(ubound(pgw,1) < r%NDGL) THEN
    CALL abort_trans('TRANS_INQ: PGW TOO SMALL')
  ELSE
    pgw(1:r%NDGL) = f%RW
  ENDIF
ENDIF

IF(PRESENT(prpnm)) THEN
  iu1 = ubound(prpnm,1)
  iu2 = ubound(prpnm,2)
  IF(iu1 < r%NDGNH) THEN
    CALL abort_trans('TRANS_INQ:FIRST DIM. OF PRNM TOO SMALL')
  ELSE
    iu1 = min(iu1,r%NLEI3)
    iu2 = min(iu2,d%NSPOLEGL)
    prpnm(1:iu1,1:iu2) = f%RPNM(1:iu1,1:iu2)
  ENDIF
ENDIF
IF(PRESENT(klei3)) THEN
  klei3=r%NLEI3
ENDIF
IF(PRESENT(kspolegl)) THEN
  kspolegl=d%NSPOLEGL
ENDIF
IF(PRESENT(kpms)) THEN
  IF(ubound(kpms,1) < r%NSMAX) THEN
    CALL abort_trans('TRANS_INQ: KPMS TOO SMALL')
  ELSE
    kpms(0:r%NSMAX) = d%NPMS(0:r%NSMAX)
  ENDIF
ENDIF
!     ------------------------------------------------------------------

!endif INTERFACE

END SUBROUTINE trans_inq