source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phylmd/rrtm/sumplatbeq_mod.F90 @ 5396

Last change on this file since 5396 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.9 KB
Line 
1MODULE SUMPLATBEQ_MOD
2CONTAINS
3SUBROUTINE 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
60USE PARKIND1  ,ONLY : JPIM     ,JPRB
61
62USE TPM_DISTR
63USE EQ_REGIONS_MOD
64USE ABORT_TRANS_MOD
65
66IMPLICIT NONE
67
68
69!     * DUMMY:
70INTEGER(KIND=JPIM),INTENT(IN)  :: KDGSA
71INTEGER(KIND=JPIM),INTENT(IN)  :: KDGL
72INTEGER(KIND=JPIM),INTENT(IN)  :: KPROC
73INTEGER(KIND=JPIM),INTENT(IN)  :: KPROCA
74INTEGER(KIND=JPIM),INTENT(IN)  :: KLOENG(KDGSA:KDGL)
75LOGICAL,INTENT(IN)  :: LDSPLIT
76LOGICAL,INTENT(IN)  :: LDEQ_REGIONS
77INTEGER(KIND=JPIM),INTENT(OUT)  :: KMEDIAP
78INTEGER(KIND=JPIM),INTENT(OUT)  :: KRESTM
79INTEGER(KIND=JPIM),INTENT(OUT)  :: KINDIC(KPROCA)
80INTEGER(KIND=JPIM),INTENT(OUT)  :: KLAST(KPROCA)
81
82!     * LOCAL:
83
84!     LOCAL INTEGER SCALARS
85INTEGER(KIND=JPIM) :: ICOMP, IGL, IMAXI, IMEDIA, IMEDIAP, ITOT, JA, JB, IA, JGL,&
86            &ILAST,IREST,IPE,I2REGIONS
87LOGICAL   :: LLDONE
88
89!      -----------------------------------------------------------------
90
91!*       1.    COMPUTATION OF KMEDIAP, KRESTM, KINDIC, KLAST.
92!              ----------------------------------------------
93
94!     * Computation of KMEDIAP and KRESTM.
95
96IMEDIA = SUM(KLOENG(KDGSA:KDGL))
97KMEDIAP = IMEDIA / KPROC
98
99IF( 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
117ENDIF
118
119KRESTM = IMEDIA - KMEDIAP * KPROC
120IF (KRESTM  >  0) KMEDIAP = KMEDIAP + 1
121
122!     * Computation of intermediate quantities KINDIC and KLAST
123
124IF (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
159ELSE
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   
219ENDIF
220
221END SUBROUTINE SUMPLATBEQ
222END MODULE SUMPLATBEQ_MOD
Note: See TracBrowser for help on using the repository browser.