SUBROUTINE FILLV(ARR1,ARR2,IFLAG,IDIM,JDIM) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: FILLV FILL V POINTS ON E-GRID H FIELD C PRGRMMR: BLACK ORG: W/NP2 DATE: 92-12-23 C C ABSTRACT: C THIS ROUTINE FILLS VELOCITY (V) POINTS ON A MASS C POINT E-GRID. PASSED VARIABLE IFLAG TELLS THE ROUTINE C WHAT TO DO WITH NEGATIVE VALUES OBTAINED DURING THE C FILLING PROCESS C IFLAG=0, TAKE WHATEVER THE INTERPOLATION GIVES. C IFLAG=1, TRUNCATE AT ZERO. C IFLAG=2, TRUNCATE AT A VERY SMALL POSITIVE VALUE (EPS). C THE INTERPOLATION CAN USE A BILINEAR SCHEME OR CUBIC C INTERPOLATING POLYMONIALS. PARAMETERS WGTCUB AND WGTLIN C CONTROL THIS OPTION. SETTING WGTCUB TO 1.0 ACTIVATES C INTERPOLATION USING CUBIC INTERPOLATING POLYNOMIALS. C SETTING WGTCUB TO 0.0 ACTIVATES BILINEAR INTERPOLATION. C C . C C PROGRAM HISTORY LOG: C ??-??-?? BLACK - ORIGINATOR C 93-12-23 RUSS TREADON - ADDED COMMENTS AND VARIABLE C GRID DIMENSIONS TO C SUBROUTINE CALL. C 98-06-04 BLACK - CONVERSION TO 2-D C C USAGE: CALL FILLV(ARR1,ARR2,IFLAG,IDIM,JDIM) C INPUT ARGUMENT LIST: C ARR2 - VELOCITY POINT DATA ON STAGGERED E-GRID. C IFLAG - C IDIM - FIRST DIMENSION OF FILLED E-GRID. C JDIM - SECOND DIMENSION OF FILLED E-GRID. C C OUTPUT ARGUMENT LIST: C ARR1 - VELOCITY POINT DATA ON FILLED E-GRID. C C OUTPUT FILES: C NONE C C SUBPROGRAMS CALLED: C UTILITIES: C EFILL - FILL MISSING VALUES ON STAGGERED C E-GRID WITH FIELD MEAN. C COEFI - COMPUTES ROW-WISE INTERPOLATION VALUES. C COEFJ - COMPUTES COLUMN-WISE INTERPOLATION VALUES. C LIBRARY: C COMMON C C ATTRIBUTES: C LANGUAGE: FORTRAN C MACHINE : CRAY C-90 C$$$ C C---------------------------------------------------------------------- PARAMETER (WGTCUB=0.0,WGTLIN=1.-WGTCUB,EPS=1.E-5) PARAMETER (P5C=.125,P15C=3.375,P25C=15.625 1, P35C=42.875,P45C=91.125) PARAMETER (P5S=.25,P15S=2.25,P25S=6.25 1 , P35S=12.25,P45S=20.25) C---------------------------------------------------------------------- D I M E N S I O N 1 ARR1((IDIM+1)/2,JDIM),ARR2(IDIM,JDIM) C C********************************************************************** C START FILLV HERE. C C REPLACE MISSING VALUES ON EGRID WITH FIELD MEAN IM=(IDIM+1)/2 CALL EFILL(ARR1,IM,JDIM) C DO J=1,JDIM DO I=1,IDIM ARR2(I,J)=0. ENDDO ENDDO C*** C*** REASSIGN VALUES OF MODEL GRID TO IDIM X JDIM GRID ON ODD ROWS C*** DO J=1,JDIM,2 DO I=1,IDIM,2 II=(I+1)/2 ARR2(I,J)=ARR1(II,J) ENDDO ENDDO C*** C*** REASSIGN VALUES OF MODEL GRID TO IDIM X JDIM GRID ON EVEN ROWS C*** DO J=2,JDIM-1,2 DO I=2,IDIM-1,2 II=I/2 ARR2(I,J)=ARR1(II,J) ENDDO ENDDO C IF(WGTCUB.GT.0.99)GO TO 100 C*** C*** INTERPOLATE VALUES TO THOSE CORRESPONDING TO V POINTS NOW ON THE C*** IDIM X JDIM GRID FOR THE BOTTOM AND TOP ROWS. C*** DO I=2,IDIM-1,2 II=I/2 ARR2(I,1)=(ARR1(II,1)+ARR1(II+1,1))*0.5 ARR2(I,JDIM)=(ARR1(II,JDIM)+ARR1(II+1,JDIM))*0.5 ENDDO C*** C*** INTERPOLATE VALUES TO THOSE CORRESPONDING TO V POINTS NOW ON THE C*** IDIM X JDIM GRID FOR WEST AND EAST SIDES. C*** DO J=2,JDIM-1,2 ARR2(1,J)=(ARR1(1,J+1)+ARR1(1,J-1))*0.5 ARR2(IDIM,J)=(ARR1(IM,J+1)+ARR1(IM,J-1))*0.5 ENDDO C*** C*** INTERPOLATE TO CORRESPONDING V POINTS ON ALL INNER POINTS C*** OF ODD ROWS. C*** DO J=3,JDIM-2,2 DO I=2,IDIM-1,2 II=I/2 ARR2(I,J)=0.25*(ARR1(II,J)+ARR1(II+1,J) 1 +ARR1(II,J+1)+ARR1(II,J-1)) ENDDO ENDDO C*** C*** INTERPOLATE TO CORRESPONDING V POINTS ON ALL INNER POINTS C*** OF EVEN ROWS. C*** DO J=2,JDIM-1,2 DO I=3,IDIM-2,2 II=I/2 ARR2(I,J)=0.25*(ARR1(II,J)+ARR1(II+1,J) 1 +ARR1(II+1,J+1)+ARR1(II+1,J-1)) ENDDO ENDDO IF(WGTCUB.LT.0.01)GO TO 825 C*** C*** FILL IN THE VELOCITY POINTS USING CUBIC INTERPOLATING POLYNOMIALS. C*** FIRST DO THE ROWS. C*** 100 WGT1=0.5*WGTCUB+WGTLIN DO 200 J=1,JDIM,2 DO I=3,IDIM-8,2 CALL COEFI(ARR2,IDIM,JDIM,I,J,C1,C2,C3,C4) ARR2(I+3,J)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGTLIN*ARR2(I+3,J))/WGT1 ENDDO C CALL COEFI(ARR2,IDIM,JDIM,1,J,C1,C2,C3,C4) ARR2(2,J)=(0.5*WGTCUB*(C1*P15C+C2*P15S+C3*1.5+C4)+ 1 WGTLIN*ARR2(2,J))/WGT1 ARR2(4,J)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGTLIN*ARR2(4,J))/WGT1 CALL COEFI(ARR2,IDIM,JDIM,IDIM-6,J,C1,C2,C3,C4) ARR2(IDIM-3,J)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGTLIN*ARR2(IDIM-3,J))/WGT1 ARR2(IDIM-1,J)=(0.5*WGTCUB*(C1*P35C+C2*P35S+C3*3.5+C4)+ 1 WGTLIN*ARR2(IDIM-1,J))/WGT1 200 CONTINUE C DO 400 J=2,JDIMM,2 DO I=4,IDIM-9,2 CALL COEFI(ARR2,IDIM,JDIM,I,J,C1,C2,C3,C4) ARR2(I+3,J)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGTLIN*ARR2(I+3,J))/WGT1 ENDDO C CALL COEFI(ARR2,IDIM,JDIM,2,J,C1,C2,C3,C4) ARR2(1,J)=(0.5*WGTCUB*(C1*P5C+C2*P5S+C3*.5+C4)+ 1 WGTLIN*ARR2(1,J))/WGT1 ARR2(3,J)=(0.5*WGTCUB*(C1*P15C+C2*P15S+C3*1.5+C4)+ 1 WGTLIN*ARR2(3,J))/WGT1 ARR2(5,J)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGTLIN*ARR2(5,J))/WGT1 CALL COEFI(ARR2,IDIM,JDIM,IDIM-7,J,C1,C2,C3,C4) ARR2(IDIM-4,J)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGTLIN*ARR2(IDIM-4,J))/WGT1 ARR2(IDIM-2,J)=(0.5*WGTCUB*(C1*P35C+C2*P35S+C3*3.5+C4)+ 1 WGTLIN*ARR2(IDIM-2,J))/WGT1 ARR2(IDIM,J)=(0.5*WGTCUB*(C1*P45C+C2*P45S+C3*4.5+C4)+ 1 WGTLIN*ARR2(IDIM,J))/WGT1 400 CONTINUE C*** C*** NOW DO THE COLUMNS. C*** WGT2=0.5*WGTCUB+WGT1 DO 600 I=1,IDIM,2 DO J=3,JDIM-8,2 CALL COEFJ(ARR2,IDIM,JDIM,I,J,C1,C2,C3,C4) ARR2(I,J+3)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGT1*ARR2(I,J+3))/WGT2 ENDDO C CALL COEFJ(ARR2,IDIM,JDIM,I,1,C1,C2,C3,C4) ARR2(I,2)=(0.5*WGTCUB*(C1*P15C+C2*P15S+C3*1.5+C4)+ 1 WGT1*ARR2(I,2))/WGT2 ARR2(I,4)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGT1*ARR2(I,4))/WGT2 CALL COEFJ(ARR2,IDIM,JDIM,I,JDIM-6,C1,C2,C3,C4) ARR2(I,JDIM-3)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGT1*ARR2(I,JDIM-3))/WGT2 ARR2(I,JDIM-1)=(0.5*WGTCUB*(C1*P35C+C2*P35S+C3*3.5+C4)+ 1 WGT1*ARR2(I,JDIM-1))/WGT2 600 CONTINUE C DO 800 I=2,IDIM-1,2 DO J=4,JDIM-9,2 CALL COEFJ(ARR2,IDIM,JDIM,I,J,C1,C2,C3,C4) ARR2(I,J+3)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGT1*ARR2(I,J+3))/WGT2 ENDDO C CALL COEFJ(ARR2,IDIM,JDIM,I,2,C1,C2,C3,C4) ARR2(I,1)=(0.5*WGTCUB*(C1*P5C+C2*P5S+C3*.5+C4)+ 1 WGT1*ARR2(I,1))/WGT2 ARR2(I,3)=(0.5*WGTCUB*(C1*P15C+C2*P15S+C3*1.5+C4)+ 1 WGT1*ARR2(I,3))/WGT2 ARR2(I,5)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGT1*ARR2(I,5))/WGT2 CALL COEFJ(ARR2,IDIM,JDIM,I,JDIM-7,C1,C2,C3,C4) ARR2(I,JDIM-4)=(0.5*WGTCUB*(C1*P25C+C2*P25S+C3*2.5+C4)+ 1 WGT1*ARR2(I,JDIM-4))/WGT2 ARR2(I,JDIM-2)=(0.5*WGTCUB*(C1*P35C+C2*P35S+C3*3.5+C4)+ 1 WGT1*ARR2(I,JDIM-2))/WGT2 ARR2(I,JDIM)=(0.5*WGTCUB*(C1*P35C+C2*P35S+C3*3.5+C4)+ 1 WGT1*ARR2(I,JDIM))/WGT2 800 CONTINUE C 825 IF(IFLAG.EQ.1)THEN DO J=1,JDIM,2 DO I=2,IDIM-1,2 IF(ARR2(I,J).LT.0.)ARR2(I,J)=0. ENDDO ENDDO C DO J=2,JDIM-1,2 DO I=1,IDIM,2 IF(ARR2(I,J).LT.0.)ARR2(I,J)=0. ENDDO ENDDO ELSEIF(IFLAG.EQ.2)THEN DO J=1,JDIM,2 DO I=2,IDIM-1,2 IF(ARR2(I,J).LT.0.)ARR2(I,J)=EPS ENDDO ENDDO C DO J=2,JDIM-1,2 DO I=1,IDIM,2 IF(ARR2(I,J).LT.0.)ARR2(I,J)=EPS ENDDO ENDDO ENDIF C C END OF ROUTINE. C RETURN END