! (C) Copyright 2000- ECMWF. ! (C) Copyright 2000- 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. ! MODULE FOURIER_IN_MOD CONTAINS SUBROUTINE FOURIER_IN(PREEL, KFIELDS, KGL) !**** *FOURIER_IN* - Copy fourier data from buffer to local array ! Purpose. ! -------- ! Routine for copying fourier data from buffer to local array !** Interface. ! ---------- ! CALL FOURIER_IN(...) ! Explicit arguments : PREEL - local fourier/GP array ! -------------------- KFIELDS - number of fields ! KGL - local index of latitude we are currently on ! ! Externals. None. ! ---------- ! Author. ! ------- ! Mats Hamrud *ECMWF* ! Modifications. ! -------------- ! Original : 2000-04-01 ! ------------------------------------------------------------------ USE PARKIND1, ONLY : JPIM, JPRB USE TPM_DISTR, ONLY : D, MYSETW USE TPM_TRANS, ONLY : FOUBUF USE TPM_GEOMETRY, ONLY : G IMPLICIT NONE REAL(KIND=JPRB), INTENT(OUT) :: PREEL(:,:) INTEGER(KIND=JPIM), INTENT(IN) :: KFIELDS INTEGER(KIND=JPIM), INTENT(IN) :: KGL INTEGER(KIND=JPIM) :: JM, JF, IGLG, IPROC, IR, II, ISTA ! ------------------------------------------------------------------ ! Determine global latitude index corresponding to local latitude index KGL IGLG = D%NPTRLS(MYSETW) + KGL - 1 ! Loop over all zonal wavenumbers relevant for this latitude DO JM = 0, G%NMEN(IGLG) ! Get the member of the W-set responsible for this zonal wavenumber in the "m" representation IPROC = D%NPROCM(JM) ! Compute offset in FFT work array PREEL corresponding to wavenumber JM and latitude KGL IR = 2 * JM + 1 + D%NSTAGTF(KGL) II = 2 * JM + 2 + D%NSTAGTF(KGL) ! Compute offset for extraction of the fields from the m-to-l transposition buffer, FOUBUF ISTA = (D%NSTAGT0B(D%MSTABF(IPROC)) + D%NPNTGTB0(JM,KGL)) * 2 * KFIELDS ! Copy all fields from m-to-l transposition buffer to FFT work array DO JF = 1, KFIELDS PREEL(JF,IR) = FOUBUF(ISTA+2*JF-1) PREEL(JF,II) = FOUBUF(ISTA+2*JF) ENDDO ENDDO ! ------------------------------------------------------------------ END SUBROUTINE FOURIER_IN END MODULE FOURIER_IN_MOD