GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/sumplatbeq_mod.F90 Lines: 0 67 0.0 %
Date: 2023-06-30 12:51:15 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