7 kindex,kissox,kissoy,pvalue,pnodata)
33 nnlati, nnlopa, xlapo, xlopo, xcodil, xsints, &
34 xlon, xlat, xcost, xsintc, xcosn, xsinn, xlonp, &
35 xlatp, xcosp, xsinp, xpi, x1, x2, xdr, &
36 nfracdx, nfracgx, nfracdy, nfacty, xxdif, xydif,&
41 USE yomhook
,ONLY : lhook, dr_hook
42 USE parkind1
,ONLY : jprb
49 INTEGER,
INTENT(IN) :: knblines
50 INTEGER,
INTENT(IN) :: kgrid_par
51 INTEGER,
INTENT(IN) :: ksso
52 REAL,
DIMENSION(:),
INTENT(IN) :: pgrid_par
53 REAL,
DIMENSION(:),
INTENT(IN) :: plat
54 REAL,
DIMENSION(:),
INTENT(IN) :: plon
55 INTEGER,
DIMENSION(:,:),
INTENT(OUT) :: kindex
56 INTEGER,
DIMENSION(:,:),
INTENT(OUT) :: kissox
57 INTEGER,
DIMENSION(:,:),
INTENT(OUT) :: kissoy
59 REAL,
DIMENSION(:),
OPTIONAL,
INTENT(IN) :: pvalue
60 REAL,
OPTIONAL,
INTENT(IN) :: pnodata
66 REAL,
DIMENSION(SIZE(PLAT)) :: zx, zy
67 REAL,
DIMENSION(SIZE(PLAT)) :: zvalue
71 INTEGER,
DIMENSION(SIZE(PLAT)) :: icj
72 INTEGER :: ilgrid, isize
73 INTEGER :: ifactx, isizex, isizey
75 INTEGER :: jgrid, igrid0
77 REAL(KIND=JPRB) :: zhook_handle
80 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_1',0,zhook_handle)
82 IF (present(pvalue) .AND. present(pnodata))
THEN
94 IF (.NOT.
ALLOCATED(nnlopa))
THEN
104 ALLOCATE(nnlopa(0:nnlati))
105 ALLOCATE(xxcen(ilgrid))
106 ALLOCATE(xycen(ilgrid))
108 ilgrid,plat_xy=xycen,plon_xy=xxcen )
124 ALLOCATE(xxinf(ilgrid))
125 ALLOCATE(xyinf(ilgrid))
126 ALLOCATE(xxsup(ilgrid))
127 ALLOCATE(xysup(ilgrid))
128 ALLOCATE(xxdif(ilgrid))
129 ALLOCATE(xydif(ilgrid))
133 xxdif(jj) = 1. / (xxsup(jj) - xxinf(jj))
134 xydif(jj) = 1. / (xysup(jj) - xyinf(jj))
137 ifactx = floor(sqrt(float(nnlati))) + 1
138 isizex = floor(float(nnlati) / ifactx)
140 ALLOCATE(nfracdx(0:ifactx))
141 ALLOCATE(nfracgx(0:ifactx))
147 nfracdx(ifactx) = nnlati
148 nfracgx(ifactx) = sum(nnlopa(:))
150 nfracdx(jj) = 1 + (jj-1) * isizex
151 nfracgx(jj) = nfracgx(jj-1) + sum(nnlopa(nfracdx(jj-1):(jj-1)*isizex))
155 ALLOCATE(nfacty(nnlati))
156 nfacty(:) = floor(sqrt(float(nnlopa(1:nnlati))))+1
158 ALLOCATE(nfracdy(nnlati,0:maxval(nfacty)))
161 isizey = floor(float(nnlopa(jj)) / nfacty(jj))
164 nfracdy(jj,nfacty(jj)) = nnlopa(jj)
166 nfracdy(jj,ji) = 1 + (ji-1) * isizey
174 IF (xcodil==1.0.AND.xlapo==90.0.AND.xlopo==0.0) lrotstretch = .false.
178 isize =
SIZE(plat)/knblines
180 IF (
ALLOCATED(xlon))
THEN
181 IF ( isize/=
SIZE(xlon) .OR. knblines/=
SIZE(xlat) )
THEN
192 IF (.NOT.
ALLOCATED(xlon))
THEN
194 ALLOCATE(xlon(isize))
195 ALLOCATE(xlat(knblines))
197 ALLOCATE(xcost(
SIZE(xlat)))
198 ALLOCATE(xsintc(
SIZE(xlat)))
199 ALLOCATE(xsints(
SIZE(xlat)))
200 ALLOCATE(xcosn(
SIZE(xlon)))
201 ALLOCATE(xsinn(
SIZE(xlon)))
203 xlon(:) =
angle_domain(plon(1:isize),dom=
'0+',unit=
'D') * xdr
204 xcosn(:) = cos(xlon(:)-xlonp)
205 xsinn(:) = sin(xlon(:)-xlonp)
209 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_1',1,zhook_handle)
210 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_2',0,zhook_handle)
217 xlat(jj) = plat(jj*isize) * xdr
218 xsintc(jj) = sin(xlat(jj)) * xcosp
219 xsints(jj) = sin(xlat(jj)) * xsinp
220 xcost(jj) = cos(xlat(jj))
223 IF (lrotstretch)
THEN
224 CALL
xy_gauss(xcodil,isize,znodata,zvalue,zy,zx)
230 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_2',1,zhook_handle)
231 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_3',0,zhook_handle)
240 ifactx =
SIZE(nfracdx)
244 IF (zvalue(jl)==znodata) cycle
249 IF (zy(jl)>=xyinf(nfracgx(jj)))
THEN
251 jgrid = nfracgx(jj-1)
253 DO ji=nfracdx(jj-1)+1,nfracdx(jj)-1
255 jgrid = jgrid + nnlopa(ji-1)
257 IF (zy(jl)>=xyinf(jgrid))
THEN
266 icj(jl) = nfracdx(jj)
277 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_3',1,zhook_handle)
278 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_4',0,zhook_handle)
283 IF (zvalue(jl)==znodata) cycle
286 IF (icj(jl)/=1) igrid0 = sum(nnlopa(1:icj(jl)-1))
290 DO jj = 1,nfacty(icj(jl))
292 IF (zx(jl)<xxsup(igrid0+nfracdy(icj(jl),jj)))
THEN
294 jgrid = igrid0 + nfracdy(icj(jl),jj-1)
296 DO ji=nfracdy(icj(jl),jj-1)+1,nfracdy(icj(jl),jj)
299 IF (zx(jl)<=xxcen(jgrid)-180. .AND. zx(jl)<xxsup(jgrid)-360.) zx(jl) = zx(jl) + 360.
301 IF (zx(jl)>=xxinf(jgrid) .AND. zx(jl)<xxsup(jgrid))
THEN
318 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_4',1,zhook_handle)
319 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_5',0,zhook_handle)
327 IF (kindex(1,jl)/=0)
THEN
328 kissox(1,jl) = 1 + int( float(ksso) * (zx(jl)-xxinf(kindex(1,jl)))/(xxsup(kindex(1,jl))-xxinf(kindex(1,jl))) )
329 kissoy(1,jl) = 1 + int( float(ksso) * (zy(jl)-xyinf(kindex(1,jl)))/(xysup(kindex(1,jl))-xyinf(kindex(1,jl))) )
335 IF (lhook) CALL dr_hook(
'GET_MESH_INDEX_GAUSS_5',1,zhook_handle)
subroutine get_gridtype_gauss(PGRID_PAR, KNLATI, PLAPO, PLOPO, PCODIL, KNLOPA, KL, PLAT, PLON, PLAT_XY, PLON_XY, PMESH_SIZE, PLONINF, PLATINF, PLONSUP, PLATSUP)
subroutine gauss_grid_limits(KNLATI, KNLOPA, PXINF, PXSUP, PYINF, PYSUP)
subroutine get_mesh_index_gauss(KNBLINES, KGRID_PAR, KSSO, PGRID_PAR, PLAT, PLON, KINDEX, KISSOX, KISSOY, PVALUE, PNODATA)
subroutine xy_gauss(PCODIL, KSIZE, PNODATA, PVALUE, PLAT_XY, PLON_XY)