SUBROUTINE INTERP3(EGFUL,GDOUT,IMOT,JMOT) C C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: INTERP3 BILINEAR INTERPOLATION C PRGRMMR: TREADON ORG: W/NP2 DATE: 92-12-23 C C ABSTRACT: C THIS ROUTINE BILINEARLY INTERPOLATES DATA FROM A C REGULAR INPUT GRID (FILLED E-GRID) TO A SPECIFIED C REGULAR OUTPUT GRID. THE ROUTINE ASSUMES THE C INTERPOLATION COEFFICIENTS HAVE BEEN PRECOMPUTED C EITHER EARLIER IN THE POST RUN BY SUBROUTINE GENBIL C OR READ IN WHILE IN SUBROUTINE READCNTRL2. C . C C PROGRAM HISTORY LOG: C ??-??-?? DAVID PLUMMER - SUBROUTINE INTERP C 92-12-23 RUSS TREADON - BROKE INTERP INTO SEVERAL PIECES C ONE OF WHICH BECAME THIS C INTERPOLATION ROUTINE. C 95-05-03 MIKE BALDWIN - ADDED BIT MAP ARRAY C C USAGE: CALL INTERP3(EGFUL,GDOUT,IMOT,JMOT) C INPUT ARGUMENT LIST: C EGFUL - DATA ON FILLED E-GRID. C IMOT - FIRST DIMENSION OF OUTPUT GRID. C JMOT - SECOND DIMENSION OF OUTPUT GRID. C C OUTPUT ARGUMENT LIST: C GDOUT - DATA INTERPOLATED TO OUTPUT GRID. C C OUTPUT FILES: C STDOUT - RUN TIME STANDARD OUT. C C SUBPROGRAMS CALLED: C UTILITIES: C EXTEND - FILLS MISSING VALUES ON OUTPUT GRID WITH C EITHER AN EXTENSION OF BORDER VALUES OR C THE FIELD MEAN. C LIBRARY: C COMMON - OPTIONS C LLGRDS C IOUNIT C C ATTRIBUTES: C LANGUAGE: FORTRAN C MACHINE : CRAY Y-MP C$$$ C C C INCLUDE DECLARED GRID DIMENSIONS. C----------------------------------------------------------------- INCLUDE "parmeta" INCLUDE "parmout" C----------------------------------------------------------------- PARAMETER (IMT=2*IM-1,JMT=JM) C C DECLARE VARIABLES. C----------------------------------------------------------------- INTEGER IMOT,JMOT REAL EGFUL(IMT,JMT),GDOUT(IMOT,JMOT) DOUBLE PRECISION SUM C----------------------------------------------------------------- C C INCLUDE COMMON. INCLUDE "OPTIONS.comm" INCLUDE "LLGRDS.comm" INCLUDE "BITMAP.comm" INCLUDE "IOUNIT.comm" C C SET TOLERANCE LIMITS. C DATA MXPASS,SPVC,SMALL /2,1.E20,1.E-4/ C C****************************************************************** C START INTERP3 HERE. C C BILINEAR INTERPOLATION OF FILLED E-GRID TO OUTPUT GRID. C THE WEIGHT ARRAYS W*(I,J) ARE PASSED THROUGH COMMON C BLOCK LLGRDS. WHILE INTERPOLATING, COMPUTE FIELD C AVERAGE ON OUTPUT GRID. C SUM = 0.0 NPTS=0 C !$omp parallel do DO J=1,JMOT DO I=1,IMOT GDOUT(I,J)=SPVC ENDDO ENDDO C !$omp parallel do !$omp& private(m,n) DO 120 J = 1,JMOT DO 120 I = 1,IMOT c GDOUT(I,J) = SPVC IBMAP(I,J) = IWGT(I,J) IF (IWGT(I,J).EQ.1) THEN M = IEGRD(I,J) N = JEGRD(I,J) GDOUT(I,J) = X WIJ(I,J) *EGFUL(M,N) + X WIPJ(I,J) *EGFUL(M+1,N) + X WIJP(I,J) *EGFUL(M,N+1) + X WIPJP(I,J)*EGFUL(M+1,N+1) ENDIF 120 CONTINUE C DO J=1,JMOT DO I=1,IMOT IF(IWGT(I,J).EQ.1)THEN SUM=SUM+GDOUT(I,J) NPTS=NPTS+1 ENDIF ENDDO ENDDO C IF(NPTS.EQ.0)THEN WRITE(STDOUT,*)'INTERP3: OUTPUT GRID NPTS IS ZERO' RETURN ENDIF AVG=SUM/NPTS C C DONE WITH INTERPOLATION. FILL MISSING VALUES WITH BOUNDARY VALUES. C CALL EXTEND(GDOUT,IMOT,JMOT,AVG,SPVC) print*,'End of INTERP3' C C END OF ROUTINE. C RETURN END