source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phylmd/rrtm/sump_trans_mod.F90 @ 5360

Last change on this file since 5360 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.8 KB
Line 
1MODULE SUMP_TRANS_MOD
2CONTAINS
3SUBROUTINE SUMP_TRANS
4
5! Set up distributed environment for the transform package (part 2)
6
7USE PARKIND1  ,ONLY : JPIM     ,JPRB
8
9USE TPM_GEN
10USE TPM_DIM
11USE TPM_GEOMETRY
12USE TPM_DISTR
13
14USE SUWAVEDI_MOD
15USE PE2SET_MOD
16USE SUMPLATF_MOD
17USE SUMPLAT_MOD
18USE SUSTAONL_MOD
19USE MYSENDSET_MOD
20USE MYRECVSET_MOD
21USE EQ_REGIONS_MOD
22
23IMPLICIT NONE
24
25INTEGER(KIND=JPIM) :: JM,JMLOC
26INTEGER(KIND=JPIM) :: JGL,IGL,IPLAT,ISENDSET,IRECVSET,JML,IPOS,IM
27INTEGER(KIND=JPIM) :: I1,I2,I3,IAUX0,IAUX1,JA1
28INTEGER(KIND=JPIM) :: IGPTOT,IMEDIAP,IRESTM,JA,JB,IOFF
29INTEGER(KIND=JPIM),ALLOCATABLE :: IGPTOTL(:,:)
30
31LOGICAL    :: LLP1,LLP2
32
33!     ------------------------------------------------------------------
34
35
36LLP1 = NPRINTLEV>0
37LLP2 = NPRINTLEV>1
38IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUMP_TRANS ==='
39
40ALLOCATE(D%NULTPP(NPRTRNS))
41IF(LLP2)WRITE(NOUT,9) 'D%NULTPP   ',SIZE(D%NULTPP   ),SHAPE(D%NULTPP   )
42ALLOCATE(D%NPTRLS(NPRTRNS))
43IF(LLP2)WRITE(NOUT,9) 'D%NPTRLS   ',SIZE(D%NPTRLS   ),SHAPE(D%NPTRLS   )
44ALLOCATE(D%NPROCL(R%NDGL))
45IF(LLP2)WRITE(NOUT,9) 'D%NPROCL   ',SIZE(D%NPROCL   ),SHAPE(D%NPROCL   )
46
47CALL SUMPLATF(R%NDGL,NPRTRNS,MYSETW,D%NULTPP,D%NPROCL,D%NPTRLS)
48D%NDGL_FS = D%NULTPP(MYSETW)
49
50! Help arrays for spectral to fourier space transposition
51ALLOCATE(D%NLTSGTB (NPRTRNS+1))
52IF(LLP2)WRITE(NOUT,9) 'D%NLTSGTB ',SIZE(D%NLTSGTB),SHAPE(D%NLTSGTB)
53ALLOCATE(D%NLTSFTB (NPRTRNS+1))
54IF(LLP2)WRITE(NOUT,9) 'D%NLTSFTB ',SIZE(D%NLTSFTB),SHAPE(D%NLTSFTB)
55ALLOCATE(D%NSTAGT0B(NPRTRNS+1))
56IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT0B ',SIZE(D%NSTAGT0B),SHAPE(D%NSTAGT0B)
57ALLOCATE(D%NSTAGT1B(NPRTRNS+1))
58IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT1B ',SIZE(D%NSTAGT1B),SHAPE(D%NSTAGT1B)
59ALLOCATE(D%MSTABF  (NPRTRNS+1))
60IF(LLP2)WRITE(NOUT,9) 'D%MSTABF ',SIZE(D%MSTABF),SHAPE(D%MSTABF)
61
62D%NLTSGTB(:) = 0
63DO JGL=1,D%NDGL_FS
64  IGL = D%NPTRLS(MYSETW)+JGL-1
65  DO JM=0,G%NMEN(IGL)
66    D%NLTSGTB(D%NPROCM(JM)) = D%NLTSGTB(D%NPROCM(JM))+1
67  ENDDO
68ENDDO
69DO JA=1,NPRTRW
70  IPLAT = 0
71  DO JGL=1,D%NULTPP(JA)
72    IGL = D%NPTRLS(JA)+JGL-1
73    DO JM=1,D%NUMP
74      IF(IGL > R%NDGNH-G%NDGLU(D%MYMS(JM)) .AND. IGL <= R%NDGNH+G%NDGLU(D%MYMS(JM))) THEN
75        IPLAT = IPLAT + 1
76      ENDIF
77    ENDDO
78  ENDDO
79  D%NLTSFTB(JA) = IPLAT
80ENDDO
81
82DO JA=1,NPRTRW-1
83  ISENDSET = MYSENDSET(NPRTRW,MYSETW,JA)
84  IRECVSET = MYRECVSET(NPRTRW,MYSETW,JA)
85  D%MSTABF(IRECVSET) = ISENDSET
86ENDDO
87D%MSTABF(MYSETW) = MYSETW
88
89ALLOCATE(D%NPNTGTB0(0:R%NSMAX,D%NDGL_FS))
90IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB0 ',SIZE(D%NPNTGTB0 ),SHAPE(D%NPNTGTB0 )
91ALLOCATE(D%NPNTGTB1(D%NUMP,R%NDGL))
92IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB1 ',SIZE(D%NPNTGTB1 ),SHAPE(D%NPNTGTB1 )
93
94DO JA=1,NPRTRW
95  IPOS = 0
96  DO JGL=1,D%NULTPP(MYSETW)
97    IGL = D%NPTRLS(MYSETW) + JGL - 1
98    DO JML=D%NPTRMS(JA),D%NPTRMS(JA)+D%NUMPP(JA)-1
99      IM = D%NALLMS(JML)
100      IF (IM  <=  G%NMEN(IGL)) THEN
101        D%NPNTGTB0(IM,JGL) = IPOS
102        IPOS = IPOS+1
103      ELSE
104        D%NPNTGTB0(IM,JGL) = -99
105      ENDIF
106    ENDDO
107  ENDDO
108ENDDO
109
110DO JA=1,NPRTRW
111  IPOS = 0
112  DO JGL=1,D%NULTPP(JA)
113    IGL = D%NPTRLS(JA) + JGL - 1
114    DO JM=1,D%NUMP
115      IM = D%MYMS(JM)
116      IF (IM  <=  G%NMEN(IGL)) THEN
117        D%NPNTGTB1(JM,IGL) = IPOS
118        IPOS = IPOS+1
119      ELSE
120        D%NPNTGTB1(JM,IGL) = -99
121      ENDIF
122    ENDDO
123  ENDDO
124ENDDO
125
126IAUX0 = 0
127IAUX1 = 0
128DO JA=1,NPRTRNS-1
129  I1 = MYSENDSET(NPRTRNS,MYSETW,JA)
130  I2 = MYRECVSET(NPRTRNS,MYSETW,JA)
131  DO JA1=1,NPRTRNS-1
132    IF(MYSENDSET(NPRTRNS,MYSETW,JA1) == I2) I3 =MYRECVSET(NPRTRNS,MYSETW,JA1)
133  ENDDO
134  IAUX0 = MAX(D%NLTSFTB(I1),D%NLTSGTB(I2),IAUX0)
135  IAUX1 = MAX(D%NLTSGTB(I2),D%NLTSFTB(I3),IAUX1)
136ENDDO
137IAUX0 = MAX(D%NLTSGTB(MYSETW),IAUX0)
138IAUX1 = MAX(D%NLTSGTB(MYSETW),IAUX1)
139DO JA=1,NPRTRNS+1
140  D%NSTAGT0B(JA) = (JA-1)*IAUX0
141  D%NSTAGT1B(JA) = (JA-1)*IAUX1
142ENDDO
143D%NLENGT0B = IAUX0*NPRTRNS
144D%NLENGT1B = IAUX1*NPRTRNS
145
146! GRIDPOINT SPACE
147
148ALLOCATE(D%NFRSTLAT(N_REGIONS_NS))
149IF(LLP2)WRITE(NOUT,9) 'D%NFRSTLAT ',SIZE(D%NFRSTLAT ),SHAPE(D%NFRSTLAT )
150ALLOCATE(D%NLSTLAT(N_REGIONS_NS))
151IF(LLP2)WRITE(NOUT,9) 'D%NLSTLAT  ',SIZE(D%NLSTLAT  ),SHAPE(D%NLSTLAT  )
152ALLOCATE(D%NPTRLAT(R%NDGL))
153IF(LLP2)WRITE(NOUT,9) 'D%NPTRLAT  ',SIZE(D%NPTRLAT  ),SHAPE(D%NPTRLAT  )
154ALLOCATE(D%NPTRFRSTLAT(N_REGIONS_NS))
155IF(LLP2)WRITE(NOUT,9) 'D%NPTRFRSTLAT',SIZE(D%NPTRFRSTLAT),SHAPE(D%NPTRFRSTLAT)
156ALLOCATE(D%NPTRLSTLAT(N_REGIONS_NS))
157IF(LLP2)WRITE(NOUT,9)'D%NPTRLSTLAT',SIZE(D%NPTRLSTLAT),SHAPE(D%NPTRLSTLAT)
158ALLOCATE(D%LSPLITLAT(R%NDGL))
159IF(LLP2)WRITE(NOUT,9) 'D%LSPLITLAT',SIZE(D%LSPLITLAT),SHAPE(D%LSPLITLAT)
160
161
162CALL SUMPLAT(R%NDGL,NPROC,N_REGIONS_NS,MY_REGION_NS,D%LSPLIT,LEQ_REGIONS,&
163             &D%NFRSTLAT,D%NLSTLAT,D%NFRSTLOFF,D%NPTRLAT,&
164             &D%NPTRFRSTLAT,D%NPTRLSTLAT,D%NPTRFLOFF,&
165             &IMEDIAP,IRESTM,D%LSPLITLAT)
166
167D%NDGL_GP = D%NLSTLAT(MY_REGION_NS)-D%NFRSTLOFF
168
169IF (LLP1) THEN
170  WRITE(NOUT,FMT='(/'' OUTPUT FROM ROUTINE SUMPLAT: ''/)')
171  WRITE(NOUT,FMT='('' D%NULTPP '')')
172  WRITE(NOUT,FMT='(20(1X,I4))') D%NULTPP(1:NPRTRNS)
173  WRITE(NOUT,FMT='('' D%NPROCL '')')
174  WRITE(NOUT,FMT='(20(1X,I4))') D%NPROCL(1:R%NDGL)
175  WRITE(NOUT,FMT='('' D%NFRSTLAT '')')
176  WRITE(NOUT,FMT='(20(1X,I4))') D%NFRSTLAT(1:N_REGIONS_NS)
177  WRITE(NOUT,FMT='('' D%NLSTLAT '')')
178  WRITE(NOUT,FMT='(20(1X,I4))') D%NLSTLAT(1:N_REGIONS_NS)
179  WRITE(NOUT,FMT='('' D%NFRSTLOFF  D%NPTRFLOFF '')')
180  WRITE(NOUT,FMT='(2(1X,I6))') D%NFRSTLOFF, D%NPTRFLOFF
181  WRITE(NOUT,FMT='('' D%NPTRLAT '')')
182  WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRLAT(1:R%NDGL)
183  WRITE(NOUT,FMT='('' D%LSPLITLAT '')')
184  WRITE(NOUT,FMT='(50(1X,L1))') D%LSPLITLAT(1:R%NDGL)
185  WRITE(NOUT,FMT='('' D%NPTRFRSTLAT '')')
186  WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRFRSTLAT(1:N_REGIONS_NS)
187  WRITE(NOUT,FMT='('' D%NPTRLSTLAT '')')
188  WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRLSTLAT(1:N_REGIONS_NS)
189  WRITE(NOUT,FMT='(/)')
190ENDIF
191ALLOCATE(D%NSTA(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW))
192IF(LLP2)WRITE(NOUT,9) 'D%NSTA     ',SIZE(D%NSTA     ),SHAPE(D%NSTA     )
193ALLOCATE(D%NONL(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW))
194IF(LLP2)WRITE(NOUT,9) 'D%NONL     ',SIZE(D%NONL     ),SHAPE(D%NONL     )
195
196CALL SUSTAONL(IMEDIAP,IRESTM)
197
198!  IGPTOTL is the number of grid points in each individual processor
199ALLOCATE(IGPTOTL(N_REGIONS_NS,N_REGIONS_EW))
200IGPTOTL(:,:)=0
201
202DO JA=1,N_REGIONS_NS
203  DO JB=1,N_REGIONS(JA)
204    IGPTOT = 0
205    DO JGL=D%NPTRFRSTLAT(JA),D%NPTRLSTLAT(JA)
206      IGPTOT = IGPTOT+D%NONL(JGL,JB)
207    ENDDO
208    IGPTOTL(JA,JB) = IGPTOT
209  ENDDO
210ENDDO
211D%NGPTOT = IGPTOTL(MY_REGION_NS,MY_REGION_EW)
212D%NGPTOTMX = MAXVAL(IGPTOTL)
213D%NGPTOTG = SUM(IGPTOTL)
214ALLOCATE(D%NGPTOTL(N_REGIONS_NS,N_REGIONS_EW))
215IF(LLP2)WRITE(NOUT,9) 'D%NGPTOTL     ',SIZE(D%NGPTOTL ),SHAPE(D%NGPTOTL  )
216D%NGPTOTL(:,:) = IGPTOTL(:,:)
217
218ALLOCATE(D%NSTAGTF(D%NDGL_FS))
219IF(LLP2)WRITE(NOUT,9) 'D%NSTAGTF     ',SIZE(D%NSTAGTF ),SHAPE(D%NSTAGTF  )
220IOFF = 0
221DO JGL=1,D%NDGL_FS
222  D%NSTAGTF(JGL) = IOFF
223  IGL = D%NPTRLS(MYSETW) + JGL - 1
224  IOFF = IOFF + G%NLOEN(IGL)+3
225ENDDO
226D%NLENGTF = IOFF
227
228DEALLOCATE(IGPTOTL)
229
230!     ------------------------------------------------------------------
2319 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
232
233END SUBROUTINE SUMP_TRANS
234END MODULE SUMP_TRANS_MOD
235
236
Note: See TracBrowser for help on using the repository browser.