53 xx0, xtopd, xnul, nline, nmesht
59 USE modi_write_file_map
61 USE yomhook
,ONLY : lhook, dr_hook
62 USE parkind1
,ONLY : jprb
71 INTEGER,
INTENT(IN) :: ki
75 CHARACTER(LEN=30) :: yvar
76 INTEGER :: jcat, jj, ji, idx
81 REAL :: zx1, zx2, zx3, zx4, zy1, zy2, zy3, zy4
82 REAL :: zxa, zxb, zya, zyb
83 REAL,
DIMENSION(NNCAT,NMESHT):: zwrk
84 REAL(KIND=JPRB) :: zhook_handle
86 IF (lhook) CALL dr_hook(
'MAKE_MASK_TOPD_TO_ISBA',0,zhook_handle)
101 zyt = xy0(jcat) + (jj-1) * xdxt(jcat)
102 zyt = zyt + 0.5 * xdxt(jcat)
106 zxt = xx0(jcat) + (ji-1) * xdxt(jcat)
107 zxt = zxt + 0.5 * xdxt(jcat)
109 idx = (jj-1) * nnxc(jcat) + ji
112 IF ( xtopd(jcat,idx).NE.xnul(jcat) )
THEN
114 CALL
get_coord(zxt,zyt,zx1,zx2,zx3,zx4,zy1,zy2,zy3,zy4,zxa,zya,zxb,zyb)
117 IF (zxt.LT.zxa.OR.zxt.GE.zxb.OR.zyt.LT.zya.OR.zyt.GE.zyb)
THEN
121 CALL
get_coord(zxt,zyt,zx1,zx2,zx3,zx4,zy1,zy2,zy3,zy4,zxa,zya,zxb,zyb)
123 DO WHILE (zxt.LT.zxa.OR.zxt.GE.zxb.OR.zyt.LT.zya.OR.zyt.GE.zyb)
126 WRITE(*,*)
'ZXT', zxt,
'ZYT',zyt
127 WRITE(*,*)
'indices Isba:',idxm,
'>=',ki
128 CALL
abor1_sfx(
"MAKE_MASK_TOPD_TO_ISBA: PROBLEM")
131 CALL
get_coord(zxt,zyt,zx1,zx2,zx3,zx4,zy1,zy2,zy3,zy4,zxa,zya,zxb,zyb)
134 IF (nline(jcat,idx)/=0) nmaskt(jcat,nline(jcat,idx)) = idxm
141 WHERE (nmaskt(:,:)/=nundef)
142 zwrk(:,:)=
REAL(nmaskt)
149 IF (lhook) CALL dr_hook(
'MAKE_MASK_TOPD_TO_ISBA',1,zhook_handle)
158 INTEGER,
INTENT(IN) :: kdxm
159 REAL,
INTENT(OUT) :: px1, px2, px3, px4
160 REAL,
INTENT(OUT) :: py1, py2, py3, py4
161 REAL,
DIMENSION(KI) :: zdx, zdy
163 INTEGER :: iline, ii, idxn
164 REAL(KIND=JPRB) :: zhook_handle
166 IF (lhook) CALL dr_hook(
'MAKE_MASK_TOPD_TO_ISBA:INIT_4POINTS',0,zhook_handle)
168 IF (ug%CGRID==
'IGN')
THEN
174 px1=xxi(idxn)-zdx(idxn)/2.0
175 px2=xxi(idxn)+zdx(idxn)/2.0
176 px3=xxi(idxn)-zdx(idxn)/2.0
177 px4=xxi(idxn)+zdx(idxn)/2.0
178 py1=xyi(idxn)-zdy(idxn)/2.0
179 py2=xyi(idxn)-zdy(idxn)/2.0
180 py3=xyi(idxn)+zdy(idxn)/2.0
181 py4=xyi(idxn)+zdy(idxn)/2.0
183 iline = int(kdxm/(nimax))+1
184 ii = kdxm-((iline-1)*nimax)
185 idxn = (iline-1)*(nimax+1)+ii
189 px3 = xxi(idxn+(nimax+1))
190 px4 = xxi(idxn+1+(nimax+1))
194 py3 = xyi(idxn+(nimax+1))
195 py4 = xyi(idxn+1+(nimax+1))
198 IF (lhook) CALL dr_hook(
'MAKE_MASK_TOPD_TO_ISBA:INIT_4POINTS',1,zhook_handle)
202 SUBROUTINE get_coord(PXT,PYT,PX1,PX2,PX3,PX4,PY1,PY2,PY3,PY4,&
205 REAL,
INTENT(IN) :: pxt, pyt
206 REAL,
INTENT(IN) :: px1, px2, px3, px4
207 REAL,
INTENT(IN) :: py1, py2, py3, py4
208 REAL,
INTENT(OUT) :: pxa, pya, pxb, pyb
210 REAL(KIND=JPRB) :: zhook_handle
212 IF (lhook) CALL dr_hook(
'MAKE_MASK_TOPD_TO_ISBA:GET_COORD',0,zhook_handle)
214 IF((px3-px1).EQ.0.0)
THEN
221 IF ((px4-px2).EQ.0.0)
THEN
228 IF ((py2-py1).EQ.0.0)
THEN
235 IF ((py4-py3).EQ.0.0)
THEN
242 IF (lhook) CALL dr_hook(
'MAKE_MASK_TOPD_TO_ISBA:GET_COORD',1,zhook_handle)
248 REAL,
INTENT(IN) :: px1, px2, py1, py2
249 REAL,
INTENT (OUT) :: pfa, pfb
250 REAL(KIND=JPRB) :: zhook_handle
252 IF (lhook) CALL dr_hook(
'MAKE_MASK_TOPD_TO_ISBA:GET_LINE_PARAM',0,zhook_handle)
254 pfa = (py2 - py1) / (px2 - px1)
255 pfb = py1 - pfa * px1
257 IF (lhook) CALL dr_hook(
'MAKE_MASK_TOPD_TO_ISBA:GET_LINE_PARAM',1,zhook_handle)
subroutine get_gridtype_ign(PGRID_PAR, KLAMBERT, KL, PX, PY, PDX, PDY, KDIMX, KDIMY, PXALL, PYALL)
subroutine abor1_sfx(YTEXT)
subroutine get_line_param(PX1, PY1, PX2, PY2, PFA, PFB)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine make_mask_topd_to_isba(UG, KI)
subroutine get_coord(PIN, PDIN, POUT, KSIZE)
subroutine write_file_map(PVAR, HVAR)
subroutine init_4points(KDXM, PX1, PX2, PX3, PX4, PY1, PY2, PY3, PY4)