1 | MODULE SUMPLATF_MOD |
---|
2 | CONTAINS |
---|
3 | SUBROUTINE SUMPLATF(KDGL,KPROCA,KMYSETA,& |
---|
4 | &KULTPP,KPROCL,KPTRLS) |
---|
5 | |
---|
6 | !**** *SUMPLATF * - Initialize fourier space distibution in N-S direction |
---|
7 | |
---|
8 | ! Purpose. |
---|
9 | ! -------- |
---|
10 | |
---|
11 | |
---|
12 | !** Interface. |
---|
13 | ! ---------- |
---|
14 | ! *CALL* *SUMPLATF * |
---|
15 | |
---|
16 | ! Explicit arguments - input : |
---|
17 | ! -------------------- |
---|
18 | ! KDGL -last latitude |
---|
19 | ! KPROCA -number of processors in A direction |
---|
20 | ! KMYSETA -process number in A direction |
---|
21 | |
---|
22 | ! Explicit arguments - output: |
---|
23 | ! -------------------- |
---|
24 | |
---|
25 | ! KULTPP -number of latitudes in process |
---|
26 | ! (in Fourier space) |
---|
27 | ! KPROCL -process responsible for latitude |
---|
28 | ! (in Fourier space) |
---|
29 | ! KPTRLS -pointer to first global latitude |
---|
30 | ! of process (in Fourier space) |
---|
31 | |
---|
32 | ! Implicit arguments : |
---|
33 | ! -------------------- |
---|
34 | |
---|
35 | |
---|
36 | ! Method. |
---|
37 | ! ------- |
---|
38 | ! See documentation |
---|
39 | |
---|
40 | ! Externals. SUMPLATB and SUEMPLATB. |
---|
41 | ! ---------- |
---|
42 | |
---|
43 | ! Reference. |
---|
44 | ! ---------- |
---|
45 | ! ECMWF Research Department documentation of the IFS |
---|
46 | |
---|
47 | ! Author. |
---|
48 | ! ------- |
---|
49 | ! MPP Group *ECMWF* |
---|
50 | |
---|
51 | ! Modifications. |
---|
52 | ! -------------- |
---|
53 | ! Original : 95-10-01 |
---|
54 | ! David Dent:97-06-02 parameters KFRSTLAT etc added |
---|
55 | ! JF. Estrade:97-11-13 Adaptation to ALADIN case |
---|
56 | ! J.Boutahar: 98-07-06 phasing with CY19 |
---|
57 | ! Modified 98-08-10 by K. YESSAD: removal of LRPOLE option + cleanings |
---|
58 | ! (correct computation of extrapolar latitudes for KPROCL). |
---|
59 | ! Modified 98-12-07 by K. YESSAD and C. FISCHER: cleaning. |
---|
60 | ! - merge old sumplat.F and suemplat.F |
---|
61 | ! - gather 'lelam' code and 'not lelam' code. |
---|
62 | ! - clean (useless duplication of variables, non doctor features). |
---|
63 | ! - remodularise according to lelam/not lelam |
---|
64 | ! -> lelam features in new routine suemplatb.F, |
---|
65 | ! not lelam features in new routine sumplatb.F |
---|
66 | ! ------------------------------------------------------------------ |
---|
67 | |
---|
68 | USE PARKIND1 ,ONLY : JPIM ,JPRB |
---|
69 | |
---|
70 | use tpm_geometry |
---|
71 | |
---|
72 | use sumplatb_mod |
---|
73 | |
---|
74 | |
---|
75 | IMPLICIT NONE |
---|
76 | |
---|
77 | |
---|
78 | ! * DUMMY: |
---|
79 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGL |
---|
80 | INTEGER(KIND=JPIM),INTENT(IN) :: KPROCA |
---|
81 | INTEGER(KIND=JPIM),INTENT(IN) :: KMYSETA |
---|
82 | INTEGER(KIND=JPIM),INTENT(OUT) :: KULTPP(:) |
---|
83 | INTEGER(KIND=JPIM),INTENT(OUT) :: KPROCL(:) |
---|
84 | INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLS(:) |
---|
85 | |
---|
86 | ! * LOCAL: |
---|
87 | INTEGER(KIND=JPIM) :: INDIC(KPROCA),ILAST(KPROCA) |
---|
88 | |
---|
89 | ! LOCAL INTEGER SCALARS |
---|
90 | INTEGER(KIND=JPIM) :: IA, ILAT, ISTART, IMEDIAP,IRESTM, JA, JLTLOC |
---|
91 | LOGICAL :: LLSPLIT |
---|
92 | |
---|
93 | ! ----------------------------------------------------------------- |
---|
94 | |
---|
95 | !* 1. CODE DEPENDING ON 'LELAM': COMPUTATION OF |
---|
96 | ! KMEDIAP, KRESTM, INDIC, ILAST. |
---|
97 | ! ----------------------------------------- |
---|
98 | |
---|
99 | LLSPLIT = .FALSE. |
---|
100 | |
---|
101 | CALL SUMPLATB(1,KDGL,KPROCA,G%NLOEN,LLSPLIT,& |
---|
102 | &IMEDIAP,IRESTM,INDIC,ILAST) |
---|
103 | |
---|
104 | ! ----------------------------------------------------------------- |
---|
105 | |
---|
106 | !* 2. CODE NOT DEPENDING ON 'LELAM': |
---|
107 | ! ------------------------------ |
---|
108 | |
---|
109 | |
---|
110 | |
---|
111 | ! * Definitions related to distribution of latitudes along sets |
---|
112 | ! ------------ in fourier-space ----------------------------- |
---|
113 | ISTART = 0 |
---|
114 | KULTPP(1) = ILAST(1) |
---|
115 | DO JA=1,KPROCA |
---|
116 | IF(JA > 1) THEN |
---|
117 | IF(ILAST(JA) /= 0) THEN |
---|
118 | KULTPP(JA) = ILAST(JA)-ILAST(JA-1) |
---|
119 | ELSE |
---|
120 | KULTPP(JA) = 0 |
---|
121 | ENDIF |
---|
122 | ENDIF |
---|
123 | DO JLTLOC=1,KULTPP(JA) |
---|
124 | ILAT = ISTART + JLTLOC |
---|
125 | KPROCL(ILAT) = JA |
---|
126 | ENDDO |
---|
127 | ISTART = ISTART + KULTPP(JA) |
---|
128 | ENDDO |
---|
129 | |
---|
130 | ! * Computes KPTRLS. |
---|
131 | |
---|
132 | IA = KPROCL(1) |
---|
133 | KPTRLS(IA) = 1 |
---|
134 | DO JA=IA+1,KPROCA |
---|
135 | KPTRLS(JA) = KPTRLS(JA-1) + KULTPP(JA-1) |
---|
136 | ENDDO |
---|
137 | |
---|
138 | END SUBROUTINE SUMPLATF |
---|
139 | END MODULE SUMPLATF_MOD |
---|