GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/set2pe_mod.F90 Lines: 0 22 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 20 0.0 %

Line Branch Exec Source
1
MODULE SET2PE_MOD
2
CONTAINS
3
SUBROUTINE SET2PE(KPE,KPRGPNS,KPRGPEW,KPRTRW,KPRTRV)
4
5
#ifdef DOC
6
7
!**** *SET2PE* - Convert from set numbers to PE number
8
9
!     Purpose.
10
!     --------
11
!        Convert from set numbers in either grid-point space or spectral space
12
!        to PE number
13
14
!**   Interface.
15
!     ----------
16
!        *CALL* *SET2PE(KPRGPNS,KPRGPEW,KPRTRW,KPRTRV,KPE)
17
18
!        Explicit arguments :
19
!        --------------------
20
21
!                  input :  KPRGPNS - integer A set number in grid space
22
!                                     in the range 1 .. NPRGPNS
23
!                           KPRGPEW - integer B set number in grid space
24
!                                     in the range 1 .. NPRGPEW
25
!                           KPRTRW  - integer A set number in spectral space
26
!                                     in the range 1 .. NPRTRW
27
!                           KPRTRV  - integer B set number in spectral space
28
!                                     in the range 1 .. NPRTRV
29
!                  output:  KPE     - integer processor number
30
!                                     in the range 1 .. NPROC
31
32
!                  Normally, one pair of input set numbers will be set to zero
33
!                  SET2PE will compute KPE from the first pair if they are valid numbers.
34
!                  else from the other pair,
35
36
!        Implicit arguments :  YOMMP parameters
37
!                              NPRGPNS,NPRGPEW,NPRTRW,NPRTRV,NPROC
38
39
!        --------------------
40
!     Method.
41
!     -------
42
43
!     Externals.
44
!     ----------
45
!         NONE
46
47
!     Reference.
48
!     ----------
49
!        ECMWF Research Department documentation of the IFS
50
51
!     Author.
52
!     -------
53
!        David Dent *ECMWF*
54
55
!     Modifications.
56
!     --------------
57
!        Original : 98-08-19
58
!     ------------------------------------------------------------------
59
#endif
60
61
USE PARKIND1  ,ONLY : JPIM     ,JPRB
62
63
USE TPM_DISTR
64
USE EQ_REGIONS_MOD
65
USE ABORT_TRANS_MOD
66
67
IMPLICIT NONE
68
INTEGER(KIND=JPIM),INTENT(IN) :: KPRGPNS,KPRGPEW,KPRTRW,KPRTRV
69
INTEGER(KIND=JPIM),INTENT(OUT)  :: KPE
70
71
INTEGER(KIND=JPIM) :: IPE,JA
72
!     ------------------------------------------------------------------
73
74
!*       1.    Choose from input parameters
75
!              ----------------------------
76
77
IF(KPRGPNS > 0.AND.KPRGPEW > 0) THEN
78
79
  IF( LEQ_REGIONS )THEN
80
    IF( KPRGPNS > N_REGIONS_NS )THEN
81
      WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPNS,N_REGIONS_NS
82
      CALL ABOR1(' SET2PE INVALID ARGUMENT ')
83
    ENDIF
84
    IF( KPRGPEW > N_REGIONS(KPRGPNS) )THEN
85
      WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPEW,N_REGIONS(KPRGPNS)
86
      CALL ABOR1(' SET2PE INVALID ARGUMENT ')
87
    ENDIF
88
    KPE=0
89
    DO JA=1,KPRGPNS-1
90
      KPE=KPE+N_REGIONS(JA)
91
    ENDDO
92
    KPE=KPE+KPRGPEW
93
  ELSE
94
    IF(KPRGPNS <= NPRGPNS.AND.KPRGPEW <= NPRGPEW) THEN
95
96
!*       2.    Grid-space set values supplied
97
!              ------------------------------
98
99
      KPE=(KPRGPNS-1)*NPRGPEW + KPRGPEW
100
    ELSE
101
      WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPNS,KPRGPEW
102
      CALL ABORT_TRANS(' SET2PE INVALID ARGUMENT ')
103
    ENDIF
104
  ENDIF
105
106
ELSE
107
108
!*       3.    Spectral space set values supplied
109
!              ----------------------------------
110
111
  IF(KPRTRW <= NPRTRW.AND.KPRTRV <= NPRTRV) THEN
112
    KPE=(KPRTRW-1)*NPRTRV + KPRTRV
113
  ELSE
114
    WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRTRW,KPRTRV
115
    CALL ABORT_TRANS(' SET2PE INVALID ARGUMENT ')
116
  ENDIF
117
118
ENDIF
119
120
END SUBROUTINE SET2PE
121
END MODULE SET2PE_MOD