GCC Code Coverage Report


Directory: ./
File: rad/sumplat_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 36 0.0%
Branches: 0 42 0.0%

Line Branch Exec Source
1 MODULE SUMPLAT_MOD
2 CONTAINS
3 SUBROUTINE SUMPLAT(KDGL,KPROC,KPROCA,KMYSETA,LDSPLIT,LDEQ_REGIONS,&
4 &KFRSTLAT,KLSTLAT,KFRSTLOFF,KPTRLAT,&
5 &KPTRFRSTLAT,KPTRLSTLAT,KPTRFLOFF,&
6 &KMEDIAP,KRESTM,LDSPLITLAT)
7
8 !**** *SUMPLAT * - Initialize gridpoint distrbution in N-S direction
9
10 ! Purpose.
11 ! --------
12
13
14 !** Interface.
15 ! ----------
16 ! *CALL* *SUMPLAT *
17
18 ! Explicit arguments - input :
19 ! --------------------
20 ! KDGL -last latitude
21 ! KPROC -total number of processors
22 ! KPROCA -number of processors in A direction
23 ! KMYSETA -process number in A direction
24 ! LDSPLIT -true for latitudes shared between sets
25 ! LDEQ_REGIONS -true if eq_regions partitioning
26
27 ! Explicit arguments - output:
28 ! --------------------
29 ! KMEDIAP -mean number of grid points per PE
30 ! KRESTM -number of PEs with one extra point
31 ! KFRSTLAT -first latitude row on processor
32 ! KLSTLAT -last latitude row on processor
33 ! KFRSTLOFF -offset for first latitude in set
34 ! KPTRLAT -pointer to start of latitude
35 ! KPTRFRSTLAT-pointer to first latitude
36 ! KPTRLSTLAT -pointer to last latitude
37 ! KPTRFLOFF -offset for pointer to first latitude
38 ! LDSPLITLAT -true for latitudes which are split
39
40 ! Implicit arguments :
41 ! --------------------
42
43
44 ! Method.
45 ! -------
46 ! See documentation
47
48 ! Externals. SUMPLATB and SUEMPLATB.
49 ! ----------
50
51 ! Reference.
52 ! ----------
53 ! ECMWF Research Department documentation of the IFS
54
55 ! Author.
56 ! -------
57 ! MPP Group *ECMWF*
58
59 ! Modifications.
60 ! --------------
61 ! Original : 95-10-01
62 ! David Dent:97-06-02 parameters KFRSTLAT etc added
63 ! JF. Estrade:97-11-13 Adaptation to ALADIN case
64 ! J.Boutahar: 98-07-06 phasing with CY19
65 ! Modified 98-08-10 by K. YESSAD: removal of LRPOLE option + cleanings
66 ! (correct computation of extrapolar latitudes for KPROCL).
67 ! Modified 98-12-07 by K. YESSAD and C. FISCHER: cleaning.
68 ! - merge old sumplat.F and suemplat.F
69 ! - gather 'lelam' code and 'not lelam' code.
70 ! - clean (useless duplication of variables, non doctor features).
71 ! - remodularise according to lelam/not lelam
72 ! -> lelam features in new routine suemplatb.F,
73 ! not lelam features in new routine sumplatb.F
74 ! ------------------------------------------------------------------
75
76 USE PARKIND1 ,ONLY : JPIM ,JPRB
77
78 USE TPM_GEOMETRY
79 USE TPM_DISTR
80
81 USE SUMPLATB_MOD
82 USE SUMPLATBEQ_MOD
83
84 IMPLICIT NONE
85
86
87 ! * DUMMY:
88 INTEGER(KIND=JPIM),INTENT(OUT) :: KMEDIAP
89 INTEGER(KIND=JPIM),INTENT(OUT) :: KRESTM
90 INTEGER(KIND=JPIM),INTENT(IN) :: KDGL
91 INTEGER(KIND=JPIM),INTENT(IN) :: KPROC
92 INTEGER(KIND=JPIM),INTENT(IN) :: KPROCA
93 INTEGER(KIND=JPIM),INTENT(IN) :: KMYSETA
94 INTEGER(KIND=JPIM),INTENT(OUT) :: KFRSTLAT(:)
95 INTEGER(KIND=JPIM),INTENT(OUT) :: KLSTLAT(:)
96 INTEGER(KIND=JPIM),INTENT(OUT) :: KFRSTLOFF
97 INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLAT(:)
98 INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFRSTLAT(:)
99 INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLSTLAT(:)
100 INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFLOFF
101 LOGICAL,INTENT(IN) :: LDSPLIT
102 LOGICAL,INTENT(IN) :: LDEQ_REGIONS
103 LOGICAL,INTENT(OUT) :: LDSPLITLAT(:)
104
105 ! * LOCAL:
106 ! === END OF INTERFACE BLOCK ===
107 INTEGER(KIND=JPIM) :: INDIC(KPROCA),ILAST(KPROCA)
108
109 ! LOCAL INTEGER SCALARS
110 INTEGER(KIND=JPIM) :: IPTRLATITUDE, JA, JGL
111
112
113 ! -----------------------------------------------------------------
114
115 !* 1. CODE DEPENDING ON 'LELAM': COMPUTATION OF
116 ! KMEDIAP, KRESTM, INDIC, ILAST.
117 ! -----------------------------------------
118
119
120 IF( LDEQ_REGIONS )THEN
121 CALL SUMPLATBEQ(1,KDGL,KPROC,KPROCA,G%NLOEN,LDSPLIT,LDEQ_REGIONS,&
122 &KMEDIAP,KRESTM,INDIC,ILAST)
123 ELSE
124 CALL SUMPLATB(1,KDGL,KPROCA,G%NLOEN,LDSPLIT,&
125 &KMEDIAP,KRESTM,INDIC,ILAST)
126 ENDIF
127
128 ! -----------------------------------------------------------------
129
130 !* 2. CODE NOT DEPENDING ON 'LELAM': COMPUTATION OF
131 ! KFRSTLAT TO LDSPLITLAT.
132 ! ---------------------------------------------
133
134
135 ! * Computation of first and last latitude of processor sets
136 ! ----------- in grid-point-space -----------------------
137
138 KFRSTLAT(1) = 1
139 KLSTLAT(KPROCA) = KDGL
140 DO JA=1,KPROCA-1
141 !!$ IF(MYPROC==1)THEN
142 !!$ WRITE(0,'("SUMPLAT_MOD: JA=",I3," ILAST=",I3," INDIC=",I3)')&
143 !!$ &JA,ILAST(JA),INDIC(JA)
144 !!$ ENDIF
145 IF ((.NOT. LDSPLIT) .OR. INDIC(JA) == 0) THEN
146 KFRSTLAT(JA+1) = ILAST(JA) + 1
147 KLSTLAT(JA) = ILAST(JA)
148 ELSE
149 KFRSTLAT(JA+1) = INDIC(JA)
150 KLSTLAT(JA) = INDIC(JA)
151 ENDIF
152 ENDDO
153 KFRSTLOFF=KFRSTLAT(KMYSETA)-1
154
155 ! * Initialise following data structures:-
156 ! NPTRLAT (pointer to the start of each latitude)
157 ! LSPLITLAT (TRUE if latitude is split over two A sets)
158 ! NPTRFRSTLAT (pointer to the first latitude of each A set)
159 ! NPTRLSTLAT (pointer to the last latitude of each A set)
160
161 DO JGL=1,KDGL
162 KPTRLAT (JGL)=-999
163 LDSPLITLAT(JGL)=.FALSE.
164 ENDDO
165 IPTRLATITUDE=0
166 DO JA=1,KPROCA
167 DO JGL=KFRSTLAT(JA),KLSTLAT(JA)
168 IPTRLATITUDE=IPTRLATITUDE+1
169 LDSPLITLAT(JGL)=.TRUE.
170 IF( KPTRLAT(JGL) == -999 )THEN
171 KPTRLAT(JGL)=IPTRLATITUDE
172 LDSPLITLAT(JGL)=.FALSE.
173 ENDIF
174 ENDDO
175 ENDDO
176 DO JA=1,KPROCA
177 IF( LDSPLITLAT(KFRSTLAT(JA)) .AND. JA /= 1)THEN
178 KPTRFRSTLAT(JA)=KPTRLAT(KFRSTLAT(JA))+1
179 ELSE
180 KPTRFRSTLAT(JA)=KPTRLAT(KFRSTLAT(JA))
181 ENDIF
182 IF( LDSPLITLAT(KLSTLAT(JA)) .AND. JA == KPROCA)THEN
183 KPTRLSTLAT(JA)=KPTRLAT(KLSTLAT(JA))+1
184 ELSE
185 KPTRLSTLAT(JA)=KPTRLAT(KLSTLAT(JA))
186 ENDIF
187 ENDDO
188 KPTRFLOFF=KPTRFRSTLAT(KMYSETA)-1
189 !!$IF(MYPROC==1)THEN
190 !!$ DO JGL=1,KDGL
191 !!$ WRITE(0,'("SUMPLAT_MOD: JGL=",I3," KPTRLAT=",I3," LDSPLITLAT=",L4)')&
192 !!$ & JGL,KPTRLAT(JGL),LDSPLITLAT(JGL)
193 !!$ ENDDO
194 !!$ DO JA=1,KPROCA
195 !!$ WRITE(0,'("SUMPLAT_MOD: JA=",I3," KFRSTLAT=",I3," KLSTLAT=",I3,&
196 !!$ & " KPTRFRSTLAT=",I3," KPTRLSTLAT=",I3)')&
197 !!$ & JA,KFRSTLAT(JA),KLSTLAT(JA),KPTRFRSTLAT(JA),KPTRLSTLAT(JA)
198 !!$ ENDDO
199 !!$ENDIF
200
201 ! ------------------------------------------------------------------
202
203 END SUBROUTINE SUMPLAT
204 END MODULE SUMPLAT_MOD
205