! (C) Copyright 2001- ECMWF. ! (C) Copyright 2001- Meteo-France. ! ! 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. ! SUBROUTINE ETRANS_INQ(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,& & KGPTOT,KGPTOTG,KGPTOTMX,KGPTOTL,& & KMYMS,KESM0,KUMPP,KPOSSP,KPTRMS,KALLMS,KDIM0G,& & KFRSTLAT,KLSTLAT,KFRSTLOFF,KPTRLAT,& & KPTRFRSTLAT,KPTRLSTLAT,KPTRFLOFF,KSTA,KONL,& & KULTPP,KPTRLS,& & KPRTRW,KMYSETW,KMYSETV,KMY_REGION_NS,KMY_REGION_EW,& & LDSPLITLAT,LDLINEAR_GRID,& & KSMAX,KMSMAX,KNVALUE,KMVALUE,PLEPINM,KDEF_RESOL,LDLAM,& & PMU,PGW,PRPNM,KLEI3,KSPOLEGL,KPMS,KCPL2M,KCPL4M ,KPROCM) !**** *ETRANS_INQ* - Extract information from the transform package ! Purpose. ! -------- ! Interface routine for extracting information from the T.P. !** Interface. ! ---------- ! CALL ETRANS_INQ(...) ! Explicit arguments : All arguments are optional. ! -------------------- ! KRESOL - resolution tag for which info is required ,default is the ! first defined resolution (input) ! MULTI-TRANSFORMS MANAGEMENT ! KDEF_RESOL - number or resolutions defined ! LDLAM - .T. if the corresponding resolution is LAM, .F. if it is global ! 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 ! KESM0 - 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 ! KSMAX - spectral truncation - n direction ! KMSMAX - spectral truncation - m direction ! KNVALUE - n value for each KSPEC2 spectral coeffient ! KMVALUE - m value for each KSPEC2 spectral coeffient ! LDLINEAR_GRID : .TRUE. if the grid is linear ! 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) ! PLEPINM - Eigen-values of the inverse Laplace operator ! Method. ! ------- ! Externals. ESET_RESOL - set resolution ! ---------- ! Author. ! ------- ! Mats Hamrud *ECMWF* ! Modifications. ! -------------- ! Original : 00-03-03 ! M.Hamrud 01-Oct-2003 CY28 Cleaning ! A.Nmiri 15-Nov-2007 Phasing with TFL 32R3 ! A.Bogatchev 16-Sep-2010 Phasing with TFL 36R4 ! R. El Khatib 08-Aug-2012 KSMAX,KMSMAX,KNVALUE,KMVALUE,PLEPINM,LDLAM,KDEF_RESOL,LDLINEAR_GRID ! T. Dalkilic 28-Aug-2012 KCPL4M ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK !ifndef INTERFACE USE TPM_GEN ,ONLY : NDEF_RESOL USE TPM_DIM ,ONLY : R USE TPM_DISTR ,ONLY : D, NPRTRNS, NPRTRW, MYSETV, MYSETW USE TPMALD_DIM ,ONLY : RALD USE TPMALD_DISTR ,ONLY : DALD USE TPM_GEOMETRY ,ONLY : G USE TPM_FIELDS ,ONLY : F USE TPMALD_FIELDS USE EQ_REGIONS_MOD ,ONLY : MY_REGION_EW, MY_REGION_NS, & & N_REGIONS_EW, N_REGIONS_NS USE ESET_RESOL_MOD ,ONLY : ESET_RESOL USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS !endif INTERFACE IMPLICIT NONE INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2 INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2G INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2MX INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KNUMP INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOT INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTG INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTMX INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTL(:,:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KMYMS(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KESM0(0:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KUMPP(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPOSSP(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRMS(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KALLMS(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KDIM0G(0:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KFRSTLAT(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KLSTLAT(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KFRSTLOFF INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLAT(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRFRSTLAT(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLSTLAT(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRFLOFF INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSTA(:,:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KONL(:,:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KULTPP(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLS(:) INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPRTRW INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYSETW INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYSETV INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMY_REGION_NS INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMY_REGION_EW LOGICAL ,OPTIONAL,INTENT(INOUT) :: LDSPLITLAT(:) REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PMU(:) REAL(KIND=JPRB) ,OPTIONAL :: PGW(:) ! Argument NOT used REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PRPNM(:,:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KLEI3 INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPOLEGL INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPMS(0:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KCPL2M(0:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KCPL4M(0:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPROCM(0:) INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSMAX INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMSMAX INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNVALUE(:) INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMVALUE(:) REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PLEPINM(:) INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KDEF_RESOL LOGICAL ,OPTIONAL,INTENT(OUT) :: LDLAM LOGICAL ,OPTIONAL,INTENT(OUT) :: LDLINEAR_GRID !ifndef INTERFACE INTEGER(KIND=JPIM) :: IU1,IU2 INTEGER(KIND=JPIM) :: IC, JN, JMLOC, IM, JJ, JM INTEGER(KIND=JPIM) :: ISMAX(0:R%NSMAX),ISNAX(0:RALD%NMSMAX),ICPLM(0:RALD%NMSMAX) REAL(KIND=JPHOOK) :: ZHOOK_HANDLE ! ------------------------------------------------------------------ ! Set current resolution IF (LHOOK) CALL DR_HOOK('ETRANS_INQ',0,ZHOOK_HANDLE) CALL ESET_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(KPRTRW)) KPRTRW = NPRTRW IF(PRESENT(KMYSETW)) KMYSETW = MYSETW IF(PRESENT(KMYSETV)) KMYSETV = MYSETV IF(PRESENT(KMY_REGION_NS)) KMY_REGION_NS = MY_REGION_NS IF(PRESENT(KMY_REGION_EW)) KMY_REGION_EW = MY_REGION_EW IF(PRESENT(LDLAM)) LDLAM = G%LAM IF(PRESENT(KDEF_RESOL)) KDEF_RESOL = NDEF_RESOL IF(PRESENT(KGPTOTL)) THEN IF(UBOUND(KGPTOTL,1) < N_REGIONS_NS) THEN CALL ABORT_TRANS('ETRANS_INQ: KGPTOTL DIM 1 TOO SMALL') ELSEIF(UBOUND(KGPTOTL,2) < N_REGIONS_EW) THEN CALL ABORT_TRANS('ETRANS_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(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KMYMS REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KMYMS,1) < D%NUMP) THEN CALL ABORT_TRANS('ETRANS_INQ: KMYMS TOO SMALL') ELSE KMYMS(1:D%NUMP) = D%MYMS(:) ENDIF ENDIF IF(PRESENT(KESM0)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KESM0 REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KESM0,1) < RALD%NMSMAX) THEN CALL ABORT_TRANS('ETRANS_INQ: KESM0 TOO SMALL') ELSE KESM0(0:RALD%NMSMAX) = DALD%NESM0(:) ENDIF ENDIF IF(PRESENT(KCPL2M)) THEN IF(UBOUND(KCPL2M,1) < RALD%NMSMAX) THEN CALL ABORT_TRANS('ETRANS_INQ: KCPL2M TOO SMALL') ELSE KCPL2M(0:RALD%NMSMAX) = DALD%NCPL2M(:) ENDIF ENDIF IF(PRESENT(KPROCM)) THEN IF(UBOUND(KPROCM,1) < RALD%NMSMAX) THEN CALL ABORT_TRANS('ETRANS_INQ: KPROCM TOO SMALL') ELSE KPROCM(0:RALD%NMSMAX) = D%NPROCM(:) ENDIF ENDIF IF(PRESENT(KUMPP)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KUMPP REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KUMPP,1) < NPRTRW) THEN CALL ABORT_TRANS('ETRANS_INQ: KUMPP TOO SMALL') ELSE KUMPP(1:NPRTRW) = D%NUMPP(:) ENDIF ENDIF IF(PRESENT(KPOSSP)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KPOSSP REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KPOSSP,1) < NPRTRW+1) THEN CALL ABORT_TRANS('ETRANS_INQ: KPOSSP TOO SMALL') ELSE KPOSSP(1:NPRTRW+1) = D%NPOSSP(:) ENDIF ENDIF IF(PRESENT(KPTRMS)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KPTRMS REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KPTRMS,1) < NPRTRW) THEN CALL ABORT_TRANS('ETRANS_INQ: KPTRMS TOO SMALL') ELSE KPTRMS(1:NPRTRW) = D%NPTRMS(:) ENDIF ENDIF IF(PRESENT(KALLMS)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KALLMS REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KALLMS,1) < RALD%NMSMAX+1) THEN CALL ABORT_TRANS('ETRANS_INQ: KALLMS TOO SMALL') ELSE KALLMS(1:RALD%NMSMAX+1) = D%NALLMS(:) ENDIF ENDIF IF(PRESENT(KDIM0G)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KDIM0G REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KDIM0G,1) < RALD%NMSMAX) THEN CALL ABORT_TRANS('ETRANS_INQ: KDIM0G TOO SMALL') ELSE KDIM0G(0:RALD%NMSMAX) = D%NDIM0G(0:RALD%NMSMAX) ENDIF ENDIF IF(PRESENT(KFRSTLAT)) THEN IF(UBOUND(KFRSTLAT,1) < N_REGIONS_NS) THEN CALL ABORT_TRANS('ETRANS_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('ETRANS_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('ETRANS_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('ETRANS_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('ETRANS_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('ETRANS_INQ: KSTA DIM 1 TOO SMALL') ELSEIF(UBOUND(KSTA,2) < N_REGIONS_EW) THEN CALL ABORT_TRANS('ETRANS_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('ETRANS_INQ: KONL DIM 1 TOO SMALL') ELSEIF(UBOUND(KONL,2) < N_REGIONS_EW) THEN CALL ABORT_TRANS('ETRANS_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('ETRANS_INQ: LDSPLITLAT TOO SMALL') ELSE LDSPLITLAT(1:R%NDGL) = D%LSPLITLAT(:) ENDIF ENDIF IF(PRESENT(KULTPP)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KULTPP REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KULTPP,1) < NPRTRNS) THEN CALL ABORT_TRANS('ETRANS_INQ: KULTPP TOO SMALL') ELSE KULTPP(1:NPRTRNS) = D%NULTPP(:) ENDIF ENDIF IF(PRESENT(KPTRLS)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KPTRLS REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KPTRLS,1) < NPRTRNS) THEN CALL ABORT_TRANS('ETRANS_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('ETRANS_INQ: PMU TOO SMALL') ELSE PMU(1:R%NDGL) = F%RMU ENDIF ENDIF IF(PRESENT(PRPNM)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: PRPNM REQUIRED BUT LGRIDONLY=T') ENDIF IU1 = UBOUND(PRPNM,1) IU2 = UBOUND(PRPNM,2) IF(IU1 < R%NDGNH) THEN CALL ABORT_TRANS('ETRANS_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(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KPMS REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KPMS,1) < R%NSMAX) THEN CALL ABORT_TRANS('ETRANS_INQ: KPMS TOO SMALL') ELSE KPMS(0:R%NSMAX) = D%NPMS(0:R%NSMAX) ENDIF ENDIF IF(PRESENT(KSMAX)) KSMAX = R%NSMAX IF(PRESENT(KMSMAX)) KMSMAX = RALD%NMSMAX IF(PRESENT(PLEPINM)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: PLEPINM REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(PLEPINM,1) < R%NSPEC_G/2) THEN CALL ABORT_TRANS('ETRANS_INQ: PLEPINM TOO SMALL') ELSEIF (LBOUND(PLEPINM,1) /= -1) THEN CALL ABORT_TRANS('ETRANS_INQ: LOWER BOUND OF PLEPINM SHOULD BE -1') ELSE PLEPINM(:) = FALD%RLEPINM(:) ENDIF ENDIF IF(PRESENT(KNVALUE)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KNVALUE REQUIRED BUT LGRIDONLY=T') ENDIF IF(SIZE(KNVALUE) < D%NSPEC2) THEN CALL ABORT_TRANS('ETRANS_INQ: KNVALUE TOO SMALL') ELSE CALL ELLIPS(R%NSMAX,RALD%NMSMAX,ISNAX,ISMAX) DO JM=0,RALD%NMSMAX ICPLM(JM) = 1*(ISNAX(JM)+1) ENDDO IC=1 DO JMLOC=1,D%NUMP IM=D%MYMS(JMLOC) DO JN=0,ICPLM(IM)-1 DO JJ=0,3 KNVALUE(IC+JJ)=JN ENDDO IC=IC+4 ENDDO ENDDO ENDIF ENDIF IF(PRESENT(KMVALUE)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KNVALUE REQUIRED BUT LGRIDONLY=T') ENDIF IF(SIZE(KMVALUE) < D%NSPEC2) THEN CALL ABORT_TRANS('ETRANS_INQ: KMVALUE TOO SMALL') ELSE CALL ELLIPS(R%NSMAX,RALD%NMSMAX,ISNAX,ISMAX) DO JM=0,RALD%NMSMAX ICPLM(JM) = 1*(ISNAX(JM)+1) ENDDO IC=1 DO JMLOC=1,D%NUMP IM=D%MYMS(JMLOC) DO JN=0,ICPLM(IM)-1 DO JJ=0,3 KMVALUE(IC+JJ)=IM ENDDO IC=IC+4 ENDDO ENDDO ENDIF ENDIF IF(PRESENT(KCPL4M)) THEN IF(D%LGRIDONLY) THEN CALL ABORT_TRANS('ETRANS_INQ: KCPL4M REQUIRED BUT LGRIDONLY=T') ENDIF IF(UBOUND(KCPL4M,1) < RALD%NMSMAX) THEN CALL ABORT_TRANS('ETRANS_INQ: KCPL4M TOO SMALL') ELSE CALL ELLIPS(R%NSMAX,RALD%NMSMAX,ISNAX,ISMAX) DO JM=0,RALD%NMSMAX KCPL4M(JM) = 4*(ISNAX(JM)+1) ENDDO ENDIF ENDIF IF(PRESENT(LDLINEAR_GRID)) THEN LDLINEAR_GRID = R%NSMAX > (R%NDGL -1)/3 .OR. RALD%NMSMAX > (R%NDLON -1)/3 ENDIF IF (LHOOK) CALL DR_HOOK('ETRANS_INQ',1,ZHOOK_HANDLE) ! ------------------------------------------------------------------ !endif INTERFACE END SUBROUTINE ETRANS_INQ