GCC Code Coverage Report

Directory: ./
File: rad/sumplatb_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 69 0.0%
Branches: 0 68 0.0%
Line Branch Exec Source
1 MODULE SUMPLATB_MOD
2 CONTAINS
3 ✗ SUBROUTINE SUMPLATB(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,&
4 ✗ &KMEDIAP,KRESTM,KINDIC,KLAST)
5
6 !**** *SUMPLATB * - Routine to initialize parallel environment
7
8 ! Purpose.
9 ! --------
10
11
12 !** Interface.
13 ! ----------
14 ! *CALL* *SUMPLATB *
15
16 ! Explicit arguments - input :
17 ! --------------------
18 ! KDGSA -first latitude (grid-space)
19 ! (may be different from NDGSAG)
20 ! KDGL -last latitude
21 ! KPROCA -number of processors in A direction
22 ! KLOENG -actual number of longitudes per latitude.
23 ! LDSPLIT -true for latitudes shared between sets
24
25 ! Explicit arguments - output:
26 ! --------------------
27 ! KMEDIAP -mean number of grid points per PE
28 ! KRESTM -number of PEs with one extra point
29 ! KINDIC -intermediate quantity for 'sumplat'
30 ! KLAST -intermediate quantity for 'sumplat'
31
32 ! Implicit arguments :
33 ! --------------------
34
35
36 ! Method.
37 ! -------
38 ! See documentation
39
40 ! Externals. NONE.
41 ! ----------
42
43 ! Reference.
44 ! ----------
45 ! ECMWF Research Department documentation of the IFS
46
47 ! Author.
48 ! -------
49 ! K. YESSAD (after old version of sumplat.F).
50
51 ! Modifications.
52 ! --------------
53 ! Original : 98-12-07
54 ! ------------------------------------------------------------------
55
56
57 USE PARKIND1 ,ONLY : JPIM ,JPRB
58
59 USE ABORT_TRANS_MOD
60
61 IMPLICIT NONE
62
63
64 ! * DUMMY:
65 INTEGER(KIND=JPIM),INTENT(IN) :: KDGSA
66 INTEGER(KIND=JPIM),INTENT(IN) :: KDGL
67 INTEGER(KIND=JPIM),INTENT(IN) :: KPROCA
68 INTEGER(KIND=JPIM),INTENT(IN) :: KLOENG(KDGSA:KDGL)
69 LOGICAL,INTENT(IN) :: LDSPLIT
70 INTEGER(KIND=JPIM),INTENT(OUT) :: KMEDIAP
71 INTEGER(KIND=JPIM),INTENT(OUT) :: KRESTM
72 INTEGER(KIND=JPIM),INTENT(OUT) :: KINDIC(KPROCA)
73 INTEGER(KIND=JPIM),INTENT(OUT) :: KLAST(KPROCA)
74
75 ! * LOCAL:
76 ✗ INTEGER(KIND=JPIM) :: IPP1(KPROCA),ILAST1(KPROCA)
77 ✗ INTEGER(KIND=JPIM) :: IPP(KPROCA)
78 ✗ INTEGER(KIND=JPIM) :: IFIRST(KPROCA)
79
80 ! LOCAL INTEGER SCALARS
81 INTEGER(KIND=JPIM) :: ICOMP, IGL, IMAXI, IMAXIOL, IMEDIA, ITOT, JA, JGL,&
82 &ILAST,IREST,ILIMIT,IFRST
83 LOGICAL :: LLDONE
84
85 ! -----------------------------------------------------------------
86
87 !* 1. COMPUTATION OF KMEDIAP, KRESTM, KINDIC, KLAST.
88 ! ----------------------------------------------
89
90 ! * Computation of KMEDIAP and KRESTM.
91
92 ✗ IMEDIA = SUM(KLOENG(KDGSA:KDGL))
93 ✗ KMEDIAP = IMEDIA / KPROCA
94 ✗ IF (KMEDIAP < KLOENG(KDGL/2)) THEN
95 ✗ CALL ABORT_TRANS ('SUMPLATB: KPROCA TOO BIG FOR THIS RESOLUTION')
96 ENDIF
97 ✗ KRESTM = IMEDIA - KMEDIAP * KPROCA
98 ✗ IF (KRESTM > 0) KMEDIAP = KMEDIAP + 1
99
100 ! * Computation of intermediate quantities KINDIC and KLAST
101
102 ✗ IF (LDSPLIT) THEN
103
104 IREST = 0
105 ILAST =0
106 ✗ DO JA=1,KPROCA
107 ✗ IF (JA <= KRESTM .OR. KRESTM == 0) THEN
108 ✗ ICOMP = KMEDIAP
109 ELSE
110 ✗ ICOMP = KMEDIAP - 1
111 ENDIF
112 ITOT = IREST
113 ✗ IGL = ILAST+1
114 ✗ DO JGL=IGL,KDGL
115 ILAST = JGL
116 ✗ IF(ITOT+KLOENG(JGL) < ICOMP) THEN
117 ITOT = ITOT+KLOENG(JGL)
118 ✗ ELSEIF(ITOT+KLOENG(JGL) == ICOMP) THEN
119 IREST = 0
120 ✗ KLAST(JA) = JGL
121 ✗ KINDIC(JA) = 0
122 ✗ EXIT
123 ELSE
124 ✗ IREST = KLOENG(JGL) -(ICOMP-ITOT)
125 ✗ KLAST(JA) = JGL
126 ✗ KINDIC(JA) = JGL
127 ✗ EXIT
128 ENDIF
129 ENDDO
130 ENDDO
131
132 ELSE
133
134 ✗ KINDIC(:) = 0
135
136 ✗ IMAXI = KMEDIAP-1
137 IMAXIOL = HUGE(IMAXIOL)
138 DO
139 ILIMIT = IMAXI
140 IMAXI = 0
141 IFRST = KDGL
142 ✗ ILAST1(:) = 0
143 ✗ IPP1(:) = 0
144 ✗ DO JA=KPROCA,1,-1
145 IGL = IFRST
146 ✗ LATS:DO JGL=IGL,1,-1
147 ✗ IF (IPP1(JA) < ILIMIT .OR. JA == 1) THEN
148 ✗ IFRST = JGL-1
149 ✗ IPP1(JA) = IPP1(JA) + KLOENG(JGL)
150 ✗ IF(ILAST1(JA) == 0) ILAST1(JA) = JGL
151 ELSE
152 EXIT LATS
153 ENDIF
154 ENDDO LATS
155 ✗ IMAXI = MAX (IMAXI,IPP1(JA))
156 ENDDO
157 ✗ IF(IMAXI >= IMAXIOL) EXIT
158 ✗ KLAST(:) = ILAST1(:)
159 ✗ IPP(:) = IPP1(:)
160 ✗ IMAXIOL = IMAXI
161 ENDDO
162
163 ! make the distribution more uniform
164 ! ----------------------------------
165
166 ✗ IFIRST(1) = 0
167 ✗ IF (KLAST(1) > 0) IFIRST(1) = 1
168 ✗ DO JA=2,KPROCA
169 ✗ IF (IPP(JA) > 0) THEN
170 ✗ IFIRST(JA) = KLAST(JA-1)+1
171 ELSE
172 ✗ IFIRST(JA) = 0
173 ENDIF
174 ENDDO
175
176 LLDONE = .FALSE.
177 ✗ DO WHILE( .NOT.LLDONE )
178 LLDONE = .TRUE.
179
180 ✗ DO JA=1,KPROCA-1
181 ✗ IF (IPP(JA) > IPP(JA+1)) THEN
182 ✗ IF (IPP(JA)-IPP(JA+1) > IPP(JA+1) + 2 *&
183 &KLOENG(KLAST(JA)) -IPP(JA) ) THEN
184 ✗ IPP(JA) = IPP(JA) - KLOENG(KLAST(JA))
185 ✗ IPP(JA+1) = IPP(JA+1) + KLOENG(KLAST(JA))
186 ✗ IF (KLAST(JA+1) == 0) KLAST(JA+1) = KLAST(JA)
187 ✗ IFIRST(JA+1) = KLAST(JA)
188 ✗ KLAST(JA) = KLAST(JA) - 1
189 ✗ IF (KLAST(JA) == 0) IFIRST(JA) = 0
190 LLDONE = .FALSE.
191 ENDIF
192 ELSE
193 ✗ IF( IFIRST(JA+1) > 0 )THEN
194 ✗ IF (IPP(JA+1)-IPP(JA) >= IPP(JA) + 2 *&
195 &KLOENG(IFIRST(JA+1)) -IPP(JA+1) ) THEN
196 ✗ IPP(JA) = IPP(JA) + KLOENG(IFIRST(JA+1))
197 ✗ IPP(JA+1) = IPP(JA+1) - KLOENG(IFIRST(JA+1))
198 ✗ KLAST(JA) = IFIRST(JA+1)
199 ✗ IF (IFIRST(JA) == 0) IFIRST(JA) = KLAST(JA)
200 ✗ IF (KLAST(JA+1) == KLAST(JA)) THEN
201 ✗ KLAST(JA+1) = 0
202 ✗ IFIRST(JA+1) = 0
203 ELSE
204 ✗ IFIRST(JA+1) = IFIRST(JA+1) + 1
205 ENDIF
206 LLDONE = .FALSE.
207 ENDIF
208 ENDIF
209 ENDIF
210 ENDDO
211 ENDDO
212
213 ENDIF
214
215 ✗ END SUBROUTINE SUMPLATB
216 END MODULE SUMPLATB_MOD
217