56 USE modd_surfex_mpi, ONLY : nrank, npio, nproc, ncomm, nsize, nindex, nsize_task
72 INTEGER,
INTENT(IN) :: ki
73 REAL,
DIMENSION(KI),
INTENT(IN) :: pzs
74 REAL,
DIMENSION(:),
INTENT(IN):: plat
86 REAL,
DIMENSION(:),
ALLOCATABLE :: zzs1d_full
87 REAL,
DIMENSION(:,:),
ALLOCATABLE :: zzs
89 REAL,
DIMENSION(:),
ALLOCATABLE :: zdx
90 REAL,
DIMENSION(:),
ALLOCATABLE :: zdy
92 REAL,
PARAMETER :: xpi=4.*atan(1.)
93 INTEGER,
PARAMETER :: jphext = 1
98 INTEGER :: iib, iie, ijb, ije
102 INTEGER,
DIMENSION(:),
ALLOCATABLE::idispls
103 INTEGER::jpoint,jproc
104 INTEGER::irank,inextrank,ipos
115 ALLOCATE(zzs1d_full(nix*niy))
121 ALLOCATE(idispls(0:nproc-1))
133 ipos=ipos+nsize_task(irank)
134 inextrank=nindex(ipos)
135 idispls(inextrank)=idispls(irank)+nsize_task(irank)*kind(pzs)/4
139 CALL mpi_allgatherv(pzs,
SIZE(pzs)*kind(pzs)/4,mpi_real,zzs1d_full, &
140 nsize_task(:)*kind(pzs)/4,idispls,mpi_real,ncomm,infompi)
158 ALLOCATE(zdx(nix*niy))
159 ALLOCATE(zdy(nix*niy))
161 IF (nrank==npio)
THEN
163 CALL
get_mesh_dim(ug%CGRID,
SIZE(ug%XGRID_FULL_PAR),nix*niy,ug%XGRID_FULL_PAR,zdx,zdy,ug%XMESH_SIZE)
169 CALL mpi_bcast(zdx,
SIZE(zdx)*kind(zdx)/4,mpi_real,npio,ncomm,infompi)
170 CALL mpi_bcast(zdy,
SIZE(zdy)*kind(zdy)/4,mpi_real,npio,ncomm,infompi)
179 IF (
SIZE(zzs1d_full) /= nix * niy) stop
"BIG PROBLEM WITH SIZE"
186 ALLOCATE(zzs(nix,niy))
187 ALLOCATE(xzsl(nnx,nny))
192 lrevertgrid=(plat(1)>plat(1+nix))
194 IF (lrevertgrid)
THEN
198 zzs(jx,iindy) = zzs1d_full( jx + (jy-1)*nix )
204 zzs(jx,jy) = zzs1d_full( jx + (jy-1)*nix )
209 xzsl(2:nnx-1,2:nny-1) = zzs(:,:)
210 xzsl(1,:) = xzsl(2,:)
211 xzsl(nnx,:) = xzsl(nnx-1,:)
212 xzsl(:,1) = xzsl(:,2)
213 xzsl(:,nny) = xzsl(:,nny-1)
220 ALLOCATE(xzs_xy(nnx,nny))
221 xzs_xy(2:nnx,2:nny) = 0.25*(xzsl(2:nnx,2:nny) +xzsl(1:nnx-1,2:nny) +&
222 xzsl(2:nnx,1:nny-1)+xzsl(1:nnx-1,1:nny-1))
224 xzs_xy(1,:) = xzs_xy(2,:)
225 xzs_xy(:,1) = xzs_xy(:,2)
236 xxhat(jx) = xxhat(jx-1)+zdx(jx)
239 xyhat(jy) = xyhat(jy-1)+zdy(jy)
250 iie=
SIZE(xxhat)-jphext
252 ije=
SIZE(xyhat)-jphext
254 ALLOCATE(xslopang(nnx,nny,4))
255 ALLOCATE(xslopazi(nnx,nny,4))
256 ALLOCATE(xsurf_triangle(nnx,nny,4))
275 zdzsdx=( 2.* xzsl(ji,jj) &
276 - (xzs_xy(ji,jj)+xzs_xy(ji,jj+1)) ) &
277 / (xxhat(ji+1)-xxhat(ji))
278 zdzsdy=( xzs_xy(ji,jj+1) - xzs_xy(ji,jj) ) &
279 / (xyhat(jj+1)-xyhat(jj))
281 zdzsdx=( xzs_xy(ji+1,jj+1) -xzs_xy(ji,jj+1)) &
282 / (xxhat(ji+1)-xxhat(ji))
283 zdzsdy=( (xzs_xy(ji+1,jj+1)+xzs_xy(ji,jj+1)) &
284 - 2.* xzsl(ji,jj) ) &
285 / (xyhat(jj+1)-xyhat(jj))
287 zdzsdx=( (xzs_xy(ji+1,jj)+xzs_xy(ji+1,jj+1)) &
288 - 2.* xzsl(ji,jj) ) &
289 / (xxhat(ji+1)-xxhat(ji))
290 zdzsdy=( xzs_xy(ji+1,jj+1) - xzs_xy(ji+1,jj) ) &
291 / (xyhat(jj+1)-xyhat(jj))
293 zdzsdx=( xzs_xy(ji+1,jj) - xzs_xy(ji,jj) ) &
294 / (xxhat(ji+1)-xxhat(ji))
295 zdzsdy=( 2.* xzsl(ji,jj) &
296 - (xzs_xy(ji+1,jj)+xzs_xy(ji,jj)) ) &
297 / (xyhat(jj+1)-xyhat(jj))
301 zdzsdx=min(2.0,max(-2.0,zdzsdx))
302 zdzsdy=min(2.0,max(-2.0,zdzsdy))
305 xslopang(ji,jj,jt) = atan(sqrt(zdzsdx**2+zdzsdy**2))
306 xslopazi(ji,jj,jt) = 1.5*xpi - atan2( zdzsdy, zdzsdx + sign(1.e-30,zdzsdx) )
310 xsurf_triangle(ji,jj,jt)=sqrt(1. + zdzsdx**2 + zdzsdy**2)
subroutine get_mesh_dim(HGRID, KGRID_PAR, KL, PGRID_PAR, PDX, PDY, PMESHSIZE)
subroutine init_slope_param(UG, PZS, KI, PLAT)