source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/rrtm/sumplat_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: 6.4 KB
Line 
1MODULE SUMPLAT_MOD
2CONTAINS
3SUBROUTINE 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
76USE PARKIND1  ,ONLY : JPIM     ,JPRB
77
78USE TPM_GEOMETRY
79USE TPM_DISTR
80
81USE SUMPLATB_MOD
82USE SUMPLATBEQ_MOD
83
84IMPLICIT NONE
85
86
87!     * DUMMY:
88INTEGER(KIND=JPIM),INTENT(OUT) :: KMEDIAP
89INTEGER(KIND=JPIM),INTENT(OUT) :: KRESTM
90INTEGER(KIND=JPIM),INTENT(IN)  :: KDGL
91INTEGER(KIND=JPIM),INTENT(IN)  :: KPROC
92INTEGER(KIND=JPIM),INTENT(IN)  :: KPROCA
93INTEGER(KIND=JPIM),INTENT(IN)  :: KMYSETA
94INTEGER(KIND=JPIM),INTENT(OUT) :: KFRSTLAT(:)
95INTEGER(KIND=JPIM),INTENT(OUT) :: KLSTLAT(:)
96INTEGER(KIND=JPIM),INTENT(OUT) :: KFRSTLOFF
97INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLAT(:)
98INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFRSTLAT(:)
99INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLSTLAT(:)
100INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFLOFF
101LOGICAL,INTENT(IN)  :: LDSPLIT
102LOGICAL,INTENT(IN)  :: LDEQ_REGIONS
103LOGICAL,INTENT(OUT) :: LDSPLITLAT(:)
104
105!     * LOCAL:
106! === END OF INTERFACE BLOCK ===
107INTEGER(KIND=JPIM) :: INDIC(KPROCA),ILAST(KPROCA)
108
109!     LOCAL INTEGER SCALARS
110INTEGER(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
120IF( LDEQ_REGIONS )THEN
121  CALL SUMPLATBEQ(1,KDGL,KPROC,KPROCA,G%NLOEN,LDSPLIT,LDEQ_REGIONS,&
122   &KMEDIAP,KRESTM,INDIC,ILAST)
123ELSE
124  CALL SUMPLATB(1,KDGL,KPROCA,G%NLOEN,LDSPLIT,&
125   &KMEDIAP,KRESTM,INDIC,ILAST)
126ENDIF
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
138KFRSTLAT(1) = 1
139KLSTLAT(KPROCA) = KDGL
140DO 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
152ENDDO
153KFRSTLOFF=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
161DO JGL=1,KDGL
162  KPTRLAT  (JGL)=-999
163  LDSPLITLAT(JGL)=.FALSE.
164ENDDO
165IPTRLATITUDE=0
166DO 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
175ENDDO
176DO 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
187ENDDO
188KPTRFLOFF=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
203END SUBROUTINE SUMPLAT
204END MODULE SUMPLAT_MOD
Note: See TracBrowser for help on using the repository browser.