MODULE SET2PE_MOD CONTAINS SUBROUTINE SET2PE(KPE,KPRGPNS,KPRGPEW,KPRTRW,KPRTRV) #ifdef DOC !**** *SET2PE* - Convert from set numbers to PE number ! Purpose. ! -------- ! Convert from set numbers in either grid-point space or spectral space ! to PE number !** Interface. ! ---------- ! *CALL* *SET2PE(KPRGPNS,KPRGPEW,KPRTRW,KPRTRV,KPE) ! Explicit arguments : ! -------------------- ! input : KPRGPNS - integer A set number in grid space ! in the range 1 .. NPRGPNS ! KPRGPEW - integer B set number in grid space ! in the range 1 .. NPRGPEW ! KPRTRW - integer A set number in spectral space ! in the range 1 .. NPRTRW ! KPRTRV - integer B set number in spectral space ! in the range 1 .. NPRTRV ! output: KPE - integer processor number ! in the range 1 .. NPROC ! Normally, one pair of input set numbers will be set to zero ! SET2PE will compute KPE from the first pair if they are valid numbers. ! else from the other pair, ! Implicit arguments : YOMMP parameters ! NPRGPNS,NPRGPEW,NPRTRW,NPRTRV,NPROC ! -------------------- ! Method. ! ------- ! Externals. ! ---------- ! NONE ! Reference. ! ---------- ! ECMWF Research Department documentation of the IFS ! Author. ! ------- ! David Dent *ECMWF* ! Modifications. ! -------------- ! Original : 98-08-19 ! ------------------------------------------------------------------ #endif USE PARKIND1 ,ONLY : JPIM ,JPRB USE TPM_DISTR USE EQ_REGIONS_MOD USE ABORT_TRANS_MOD IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(IN) :: KPRGPNS,KPRGPEW,KPRTRW,KPRTRV INTEGER(KIND=JPIM),INTENT(OUT) :: KPE INTEGER(KIND=JPIM) :: IPE,JA ! ------------------------------------------------------------------ !* 1. Choose from input parameters ! ---------------------------- IF(KPRGPNS > 0.AND.KPRGPEW > 0) THEN IF( LEQ_REGIONS )THEN IF( KPRGPNS > N_REGIONS_NS )THEN WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPNS,N_REGIONS_NS CALL ABOR1(' SET2PE INVALID ARGUMENT ') ENDIF IF( KPRGPEW > N_REGIONS(KPRGPNS) )THEN WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPEW,N_REGIONS(KPRGPNS) CALL ABOR1(' SET2PE INVALID ARGUMENT ') ENDIF KPE=0 DO JA=1,KPRGPNS-1 KPE=KPE+N_REGIONS(JA) ENDDO KPE=KPE+KPRGPEW ELSE IF(KPRGPNS <= NPRGPNS.AND.KPRGPEW <= NPRGPEW) THEN !* 2. Grid-space set values supplied ! ------------------------------ KPE=(KPRGPNS-1)*NPRGPEW + KPRGPEW ELSE WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPNS,KPRGPEW CALL ABORT_TRANS(' SET2PE INVALID ARGUMENT ') ENDIF ENDIF ELSE !* 3. Spectral space set values supplied ! ---------------------------------- IF(KPRTRW <= NPRTRW.AND.KPRTRV <= NPRTRV) THEN KPE=(KPRTRW-1)*NPRTRV + KPRTRV ELSE WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRTRW,KPRTRV CALL ABORT_TRANS(' SET2PE INVALID ARGUMENT ') ENDIF ENDIF END SUBROUTINE SET2PE END MODULE SET2PE_MOD