| Line |
Branch |
Exec |
Source |
| 1 |
|
|
MODULE SUMP_TRANS_MOD |
| 2 |
|
|
CONTAINS |
| 3 |
|
✗ |
SUBROUTINE SUMP_TRANS |
| 4 |
|
|
|
| 5 |
|
|
! Set up distributed environment for the transform package (part 2) |
| 6 |
|
|
|
| 7 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
| 8 |
|
|
|
| 9 |
|
|
USE TPM_GEN |
| 10 |
|
|
USE TPM_DIM |
| 11 |
|
|
USE TPM_GEOMETRY |
| 12 |
|
|
USE TPM_DISTR |
| 13 |
|
|
|
| 14 |
|
|
USE SUWAVEDI_MOD |
| 15 |
|
|
USE PE2SET_MOD |
| 16 |
|
|
USE SUMPLATF_MOD |
| 17 |
|
|
USE SUMPLAT_MOD |
| 18 |
|
|
USE SUSTAONL_MOD |
| 19 |
|
|
USE MYSENDSET_MOD |
| 20 |
|
|
USE MYRECVSET_MOD |
| 21 |
|
|
USE EQ_REGIONS_MOD |
| 22 |
|
|
|
| 23 |
|
|
IMPLICIT NONE |
| 24 |
|
|
|
| 25 |
|
|
INTEGER(KIND=JPIM) :: JM,JMLOC |
| 26 |
|
|
INTEGER(KIND=JPIM) :: JGL,IGL,IPLAT,ISENDSET,IRECVSET,JML,IPOS,IM |
| 27 |
|
|
INTEGER(KIND=JPIM) :: I1,I2,I3,IAUX0,IAUX1,JA1 |
| 28 |
|
|
INTEGER(KIND=JPIM) :: IGPTOT,IMEDIAP,IRESTM,JA,JB,IOFF |
| 29 |
|
|
INTEGER(KIND=JPIM),ALLOCATABLE :: IGPTOTL(:,:) |
| 30 |
|
|
|
| 31 |
|
|
LOGICAL :: LLP1,LLP2 |
| 32 |
|
|
|
| 33 |
|
|
! ------------------------------------------------------------------ |
| 34 |
|
|
|
| 35 |
|
|
|
| 36 |
|
✗ |
LLP1 = NPRINTLEV>0 |
| 37 |
|
|
LLP2 = NPRINTLEV>1 |
| 38 |
|
✗ |
IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUMP_TRANS ===' |
| 39 |
|
|
|
| 40 |
|
✗ |
ALLOCATE(D%NULTPP(NPRTRNS)) |
| 41 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NULTPP ',SIZE(D%NULTPP ),SHAPE(D%NULTPP ) |
| 42 |
|
✗ |
ALLOCATE(D%NPTRLS(NPRTRNS)) |
| 43 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NPTRLS ',SIZE(D%NPTRLS ),SHAPE(D%NPTRLS ) |
| 44 |
|
✗ |
ALLOCATE(D%NPROCL(R%NDGL)) |
| 45 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NPROCL ',SIZE(D%NPROCL ),SHAPE(D%NPROCL ) |
| 46 |
|
|
|
| 47 |
|
✗ |
CALL SUMPLATF(R%NDGL,NPRTRNS,MYSETW,D%NULTPP,D%NPROCL,D%NPTRLS) |
| 48 |
|
✗ |
D%NDGL_FS = D%NULTPP(MYSETW) |
| 49 |
|
|
|
| 50 |
|
|
! Help arrays for spectral to fourier space transposition |
| 51 |
|
✗ |
ALLOCATE(D%NLTSGTB (NPRTRNS+1)) |
| 52 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NLTSGTB ',SIZE(D%NLTSGTB),SHAPE(D%NLTSGTB) |
| 53 |
|
✗ |
ALLOCATE(D%NLTSFTB (NPRTRNS+1)) |
| 54 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NLTSFTB ',SIZE(D%NLTSFTB),SHAPE(D%NLTSFTB) |
| 55 |
|
✗ |
ALLOCATE(D%NSTAGT0B(NPRTRNS+1)) |
| 56 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT0B ',SIZE(D%NSTAGT0B),SHAPE(D%NSTAGT0B) |
| 57 |
|
✗ |
ALLOCATE(D%NSTAGT1B(NPRTRNS+1)) |
| 58 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT1B ',SIZE(D%NSTAGT1B),SHAPE(D%NSTAGT1B) |
| 59 |
|
✗ |
ALLOCATE(D%MSTABF (NPRTRNS+1)) |
| 60 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%MSTABF ',SIZE(D%MSTABF),SHAPE(D%MSTABF) |
| 61 |
|
|
|
| 62 |
|
✗ |
D%NLTSGTB(:) = 0 |
| 63 |
|
✗ |
DO 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 |
| 68 |
|
|
ENDDO |
| 69 |
|
✗ |
DO 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 |
| 80 |
|
|
ENDDO |
| 81 |
|
|
|
| 82 |
|
✗ |
DO JA=1,NPRTRW-1 |
| 83 |
|
✗ |
ISENDSET = MYSENDSET(NPRTRW,MYSETW,JA) |
| 84 |
|
✗ |
IRECVSET = MYRECVSET(NPRTRW,MYSETW,JA) |
| 85 |
|
✗ |
D%MSTABF(IRECVSET) = ISENDSET |
| 86 |
|
|
ENDDO |
| 87 |
|
✗ |
D%MSTABF(MYSETW) = MYSETW |
| 88 |
|
|
|
| 89 |
|
✗ |
ALLOCATE(D%NPNTGTB0(0:R%NSMAX,D%NDGL_FS)) |
| 90 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB0 ',SIZE(D%NPNTGTB0 ),SHAPE(D%NPNTGTB0 ) |
| 91 |
|
✗ |
ALLOCATE(D%NPNTGTB1(D%NUMP,R%NDGL)) |
| 92 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB1 ',SIZE(D%NPNTGTB1 ),SHAPE(D%NPNTGTB1 ) |
| 93 |
|
|
|
| 94 |
|
✗ |
DO 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 |
| 108 |
|
|
ENDDO |
| 109 |
|
|
|
| 110 |
|
✗ |
DO 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 |
| 124 |
|
|
ENDDO |
| 125 |
|
|
|
| 126 |
|
|
IAUX0 = 0 |
| 127 |
|
|
IAUX1 = 0 |
| 128 |
|
✗ |
DO 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) |
| 136 |
|
|
ENDDO |
| 137 |
|
✗ |
IAUX0 = MAX(D%NLTSGTB(MYSETW),IAUX0) |
| 138 |
|
✗ |
IAUX1 = MAX(D%NLTSGTB(MYSETW),IAUX1) |
| 139 |
|
✗ |
DO JA=1,NPRTRNS+1 |
| 140 |
|
✗ |
D%NSTAGT0B(JA) = (JA-1)*IAUX0 |
| 141 |
|
✗ |
D%NSTAGT1B(JA) = (JA-1)*IAUX1 |
| 142 |
|
|
ENDDO |
| 143 |
|
✗ |
D%NLENGT0B = IAUX0*NPRTRNS |
| 144 |
|
✗ |
D%NLENGT1B = IAUX1*NPRTRNS |
| 145 |
|
|
|
| 146 |
|
|
! GRIDPOINT SPACE |
| 147 |
|
|
|
| 148 |
|
✗ |
ALLOCATE(D%NFRSTLAT(N_REGIONS_NS)) |
| 149 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NFRSTLAT ',SIZE(D%NFRSTLAT ),SHAPE(D%NFRSTLAT ) |
| 150 |
|
✗ |
ALLOCATE(D%NLSTLAT(N_REGIONS_NS)) |
| 151 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NLSTLAT ',SIZE(D%NLSTLAT ),SHAPE(D%NLSTLAT ) |
| 152 |
|
✗ |
ALLOCATE(D%NPTRLAT(R%NDGL)) |
| 153 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NPTRLAT ',SIZE(D%NPTRLAT ),SHAPE(D%NPTRLAT ) |
| 154 |
|
✗ |
ALLOCATE(D%NPTRFRSTLAT(N_REGIONS_NS)) |
| 155 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NPTRFRSTLAT',SIZE(D%NPTRFRSTLAT),SHAPE(D%NPTRFRSTLAT) |
| 156 |
|
✗ |
ALLOCATE(D%NPTRLSTLAT(N_REGIONS_NS)) |
| 157 |
|
✗ |
IF(LLP2)WRITE(NOUT,9)'D%NPTRLSTLAT',SIZE(D%NPTRLSTLAT),SHAPE(D%NPTRLSTLAT) |
| 158 |
|
✗ |
ALLOCATE(D%LSPLITLAT(R%NDGL)) |
| 159 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%LSPLITLAT',SIZE(D%LSPLITLAT),SHAPE(D%LSPLITLAT) |
| 160 |
|
|
|
| 161 |
|
|
|
| 162 |
|
|
CALL 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 |
|
|
|
| 167 |
|
✗ |
D%NDGL_GP = D%NLSTLAT(MY_REGION_NS)-D%NFRSTLOFF |
| 168 |
|
|
|
| 169 |
|
✗ |
IF (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='(/)') |
| 190 |
|
|
ENDIF |
| 191 |
|
✗ |
ALLOCATE(D%NSTA(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW)) |
| 192 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NSTA ',SIZE(D%NSTA ),SHAPE(D%NSTA ) |
| 193 |
|
✗ |
ALLOCATE(D%NONL(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW)) |
| 194 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NONL ',SIZE(D%NONL ),SHAPE(D%NONL ) |
| 195 |
|
|
|
| 196 |
|
✗ |
CALL SUSTAONL(IMEDIAP,IRESTM) |
| 197 |
|
|
|
| 198 |
|
|
! IGPTOTL is the number of grid points in each individual processor |
| 199 |
|
✗ |
ALLOCATE(IGPTOTL(N_REGIONS_NS,N_REGIONS_EW)) |
| 200 |
|
✗ |
IGPTOTL(:,:)=0 |
| 201 |
|
|
|
| 202 |
|
✗ |
DO 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 |
| 210 |
|
|
ENDDO |
| 211 |
|
✗ |
D%NGPTOT = IGPTOTL(MY_REGION_NS,MY_REGION_EW) |
| 212 |
|
✗ |
D%NGPTOTMX = MAXVAL(IGPTOTL) |
| 213 |
|
✗ |
D%NGPTOTG = SUM(IGPTOTL) |
| 214 |
|
✗ |
ALLOCATE(D%NGPTOTL(N_REGIONS_NS,N_REGIONS_EW)) |
| 215 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NGPTOTL ',SIZE(D%NGPTOTL ),SHAPE(D%NGPTOTL ) |
| 216 |
|
✗ |
D%NGPTOTL(:,:) = IGPTOTL(:,:) |
| 217 |
|
|
|
| 218 |
|
✗ |
ALLOCATE(D%NSTAGTF(D%NDGL_FS)) |
| 219 |
|
✗ |
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGTF ',SIZE(D%NSTAGTF ),SHAPE(D%NSTAGTF ) |
| 220 |
|
|
IOFF = 0 |
| 221 |
|
✗ |
DO JGL=1,D%NDGL_FS |
| 222 |
|
✗ |
D%NSTAGTF(JGL) = IOFF |
| 223 |
|
✗ |
IGL = D%NPTRLS(MYSETW) + JGL - 1 |
| 224 |
|
✗ |
IOFF = IOFF + G%NLOEN(IGL)+3 |
| 225 |
|
|
ENDDO |
| 226 |
|
✗ |
D%NLENGTF = IOFF |
| 227 |
|
|
|
| 228 |
|
✗ |
DEALLOCATE(IGPTOTL) |
| 229 |
|
|
|
| 230 |
|
|
! ------------------------------------------------------------------ |
| 231 |
|
|
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) |
| 232 |
|
|
|
| 233 |
|
✗ |
END SUBROUTINE SUMP_TRANS |
| 234 |
|
|
END MODULE SUMP_TRANS_MOD |
| 235 |
|
|
|
| 236 |
|
|
|
| 237 |
|
|
|