c c-------------- c subroutine INTHOR(MSKVAL,tempav,tt,XON,YON,XI,YI,idim,jdim,im,jm) real tempav(idim,jdim),MSKVAL real XON(idim),YON(jdim) real XI(im),YI(jm) real tt(im,jm),ZT(4),ZTS(4) ip=171 jp=138 RESN=(XON(2)-XON(1)) c do i=1,im do j=1,jm c--------- find left low corner i1=(XI(i)-XON(1))/RESN+1.0001 j1=(YI(j)-YON(1))/RESN+1.0001 c x1=XI(i)-XON(i1) x2=XON(i1+1)-XI(i) y1=YI(j)-YON(j1) y2=YON(j1+1)-YI(j) ZT(1)=tempav(i1,j1) ZT(2)=tempav(i1+1,j1) ZT(3)=tempav(i1+1,j1+1) ZT(4)=tempav(i1,j1+1) C C******* CALCULATING FORMULA ***************************** C DO k=1,4 IF(ZT(k).EQ.MSKVAL) THEN ZTS(k)=0. ELSE ZTS(k)=1. END IF END DO C tt(I,J)=ZTS(1)*ZT(1)*X2*Y2 1 +ZTS(2)*ZT(2)*X1*Y2 2 +ZTS(3)*ZT(3)*X1*Y1 3 +ZTS(4)*ZT(4)*X2*Y1 AREA= ZTS(1)*X2*Y2 1 +ZTS(2)*X1*Y2 2 +ZTS(3)*X1*Y1 3 +ZTS(4)*X2*Y1 C IF(AREA.lt.1.E-6) THEN tt(I,J)=MSKVAL ELSE tt(I,J)=tt(I,J)/AREA END IF c----------------- if(i.eq.ip.and.j.eq.jp) then print *,' INTHOR' print *,'ip,jp,i1,j1=',ip,jp,i1,j1 write(6,101) XI(i),YI(j),XON(i1),YON(j1), * XON(i1+1),YON(j1+1) 101 format('XI(i),YI(j),XON(i1),YON(j1),', * 'XON(i1+1),YON(j1+1)',/6f7.2) write(6,102) x1,x2,y1,y2 102 format('x1,x2,y1,y2=',4f7.2) write(6,103) ZT 103 format(' ZT=',4f7.2) write(6,104) ZTS 104 format(' ZTS=',4f7.0) write(6,105) tt(i,j),AREA,RESN 105 format('tt(i,j),AREA,RESN=',f7.2,f10.5,f7.3) end if c----------------- end do end do return end