source: LMDZ5/branches/testing/libf/phylmd/rrtm/suwavedi_mod.F90 @ 5431

MODULE SUWAVEDI_MOD
CONTAINS
SUBROUTINE SUWAVEDI(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,&
                    &KUMPP,KSPEC,KSPEC2,KSPEC2MX,KPOSSP,KMYMS,&
                    &KPTRMS,KALLMS,KDIM0G)

!**** *SUWAVEDI * - Routine to initialize spectral wave distribution

!     Purpose.
!     --------
!           Initialize arrays controlling spectral wave distribution

!**   Interface.
!     ----------
!        *CALL* *SUWAVEDI *

!        Explicit arguments : 
!        --------------------
!           KSMAX    - Spectral truncation limit (input)
!           KTMAX    - Overtruncation for KSMAX (input)
!           KPRTRW   - Number of processors in A-direction (input)
!           KMYSETW  - A-set for present processor (input)
!           KASM0    - Offsets for spectral waves (output)
!           KSPOLEGL - Local version of NSPOLEG (output)
!           KPROCM   - Where a certain spectral wave belongs  (output)
!           KUMPP    - Number of spectral waves on this PE (output)
!           KSPEC    - Local version on NSPEC (output)
!           KSPEC2   - Local version on NSPEC2 (output)
!           KSPEC2MX - Maximum KSPEC2 across PEs (output)
!           KPOSSP   - Global spectral fields partitioning (output)
!           KMYMS    - This PEs spectral zonal wavenumbers (output)

!        Implicit arguments : NONE
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.   NONE.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        MPP Group *ECMWF*

!     Modifications.
!     --------------
!        Original : 96-01-10
!        L.Isaksen: 96-02-02 - Calculation of KSPEC2MX added
!        K.YESSAD : 97-02-18 - Add KTMAX, bug correction for KSPOLEGL.
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB

IMPLICIT NONE


!     DUMMY 
INTEGER(KIND=JPIM),INTENT(IN)  :: KSMAX
INTEGER(KIND=JPIM),INTENT(IN)  :: KTMAX
INTEGER(KIND=JPIM),INTENT(IN)  :: KPRTRW
INTEGER(KIND=JPIM),INTENT(IN)  :: KMYSETW
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPEC
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPEC2
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPEC2MX
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPOLEGL

INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KASM0(0:KSMAX)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPROCM(0:KSMAX)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KUMPP(KPRTRW)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KMYMS(KSMAX+1)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPOSSP(KPRTRW+1)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPTRMS(KPRTRW)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KALLMS(KSMAX+1)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KDIM0G(0:KSMAX)

!     LOCAL 
INTEGER(KIND=JPIM) :: IK, IL, IND, IPOS, ISPEC2P, JA, JM,JMLOC,IM
INTEGER(KIND=JPIM) :: ISPOLEGL,ISPEC2MX,IASM0(0:KSMAX),IPROCM(0:KSMAX)
INTEGER(KIND=JPIM) :: IUMPP(KPRTRW),IMYMS(KSMAX+1),IPOSSP(KPRTRW+1)
INTEGER(KIND=JPIM) :: IPTRMS(KPRTRW),IALLMS(KSMAX+1),IDIM0G(0:KSMAX)
INTEGER(KIND=JPIM) :: ISPEC(KPRTRW),IC(KPRTRW)


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

!*       1.    Initialize partitioning of wave numbers to PEs
!              ----------------------------------------------

ISPEC(:) = 0

IUMPP(:) = 0
IASM0(:) = -99
ISPOLEGL = 0

IL  = 1
IND = 1
IK  = 0
IPOS = 1
DO JM=0,KSMAX
  IK = IK + IND
  IF (IK > KPRTRW) THEN
    IK = KPRTRW
    IND = -1
  ELSEIF (IK < 1) THEN
    IK = 1
    IND = 1
  ENDIF
  IPROCM(JM) = IK
  ISPEC(IK) = ISPEC(IK)+KSMAX-JM+1
  IUMPP(IK) = IUMPP(IK)+1
  IF (IK == KMYSETW) THEN
    ISPOLEGL = ISPOLEGL +KTMAX+1-JM+1
    IMYMS(IL) = JM
    IASM0(JM) = IPOS
    IPOS = IPOS+(KSMAX-JM+1)*2
    IL = IL+1
  ENDIF
ENDDO

IPOSSP(1) = 1
ISPEC2P = 2*ISPEC(1)
ISPEC2MX = ISPEC2P
IPTRMS(1) = 1
DO JA=2,KPRTRW
  IPOSSP(JA) = IPOSSP(JA-1)+ISPEC2P
  ISPEC2P = 2*ISPEC(JA)
  ISPEC2MX = MAX(ISPEC2MX,ISPEC2P)
! pointer to the first wave number of a given wave-set in NALLMS array
  IPTRMS(JA) = IPTRMS(JA-1)+IUMPP(JA-1)
ENDDO
IPOSSP(KPRTRW+1) = IPOSSP(KPRTRW)+ISPEC2P

!  IALLMS :  wave numbers for all wave-set concatenated together to give all
!            wave numbers in wave-set order.
IC(:) = 0
DO JM=0,KSMAX
  IALLMS(IC(IPROCM(JM))+IPTRMS(IPROCM(JM))) = JM
  IC(IPROCM(JM)) = IC(IPROCM(JM))+1
ENDDO

IPOS = 1
DO JA=1,KPRTRW
  DO JMLOC=1,IUMPP(JA)
    IM = IALLMS(IPTRMS(JA)+JMLOC-1)
    IDIM0G(IM) = IPOS
    IPOS = IPOS+(KSMAX+1-IM)*2
  ENDDO
ENDDO

IF(PRESENT(KSPEC))    KSPEC  = ISPEC(KMYSETW)
IF(PRESENT(KSPEC2))   KSPEC2 = 2*ISPEC(KMYSETW)
IF(PRESENT(KSPEC2MX)) KSPEC2MX = ISPEC2MX
IF(PRESENT(KSPOLEGL)) KSPOLEGL = ISPOLEGL

IF(PRESENT(KASM0))  KASM0(:)  = IASM0(:)
IF(PRESENT(KPROCM)) KPROCM(:) = IPROCM(:)
IF(PRESENT(KUMPP))  KUMPP(:)  = IUMPP(:)
IF(PRESENT(KMYMS))  KMYMS(:)  = IMYMS(:)
IF(PRESENT(KPOSSP)) KPOSSP(:) = IPOSSP(:)
IF(PRESENT(KPTRMS)) KPTRMS(:) = IPTRMS(:)
IF(PRESENT(KALLMS)) KALLMS(:) = IALLMS(:)
IF(PRESENT(KDIM0G)) KDIM0G(:) = IDIM0G(:)

END SUBROUTINE SUWAVEDI
END MODULE SUWAVEDI_MOD