GCC Code Coverage Report

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