source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/rrtm/sumplatb_mod.F90

Last change on this file was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.5 KB
Line 
1MODULE SUMPLATB_MOD
2CONTAINS
3SUBROUTINE 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
57USE PARKIND1  ,ONLY : JPIM     ,JPRB
58
59USE ABORT_TRANS_MOD
60
61IMPLICIT NONE
62
63
64!     * DUMMY:
65INTEGER(KIND=JPIM),INTENT(IN)  :: KDGSA
66INTEGER(KIND=JPIM),INTENT(IN)  :: KDGL
67INTEGER(KIND=JPIM),INTENT(IN)  :: KPROCA
68INTEGER(KIND=JPIM),INTENT(IN)  :: KLOENG(KDGSA:KDGL)
69LOGICAL,INTENT(IN)  :: LDSPLIT
70INTEGER(KIND=JPIM),INTENT(OUT)  :: KMEDIAP
71INTEGER(KIND=JPIM),INTENT(OUT)  :: KRESTM
72INTEGER(KIND=JPIM),INTENT(OUT)  :: KINDIC(KPROCA)
73INTEGER(KIND=JPIM),INTENT(OUT)  :: KLAST(KPROCA)
74
75!     * LOCAL:
76INTEGER(KIND=JPIM) :: IPP1(KPROCA),ILAST1(KPROCA)
77INTEGER(KIND=JPIM) :: IPP(KPROCA)
78INTEGER(KIND=JPIM) :: IFIRST(KPROCA)
79
80!     LOCAL INTEGER SCALARS
81INTEGER(KIND=JPIM) :: ICOMP, IGL, IMAXI, IMAXIOL, IMEDIA, ITOT, JA, JGL,&
82            &ILAST,IREST,ILIMIT,IFRST
83LOGICAL   :: LLDONE
84
85!      -----------------------------------------------------------------
86
87!*       1.    COMPUTATION OF KMEDIAP, KRESTM, KINDIC, KLAST.
88!              ----------------------------------------------
89
90!     * Computation of KMEDIAP and KRESTM.
91
92IMEDIA = SUM(KLOENG(KDGSA:KDGL))
93KMEDIAP = IMEDIA / KPROCA
94IF (KMEDIAP  <  KLOENG(KDGL/2)) THEN
95  CALL ABORT_TRANS ('SUMPLATB: KPROCA TOO BIG FOR THIS RESOLUTION')
96ENDIF
97KRESTM = IMEDIA - KMEDIAP * KPROCA
98IF (KRESTM  >  0) KMEDIAP = KMEDIAP + 1
99
100!     * Computation of intermediate quantities KINDIC and KLAST
101
102IF (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
132ELSE
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
213ENDIF
214
215END SUBROUTINE SUMPLATB
216END MODULE SUMPLATB_MOD
Note: See TracBrowser for help on using the repository browser.