SUBROUTINE EXTEND(GRID,IDIM,JDIM,AVG,SPVC) C C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: EXTEND FILL MISSING BOUNDARY VALUES. C PRGRMMR: TREADON ORG: W/NP2 DATE: 93-02-03 C C ABSTRACT: C THIS SUBROUTINE EXTENDS KNOW BOUNDARY VALUES TO FILL C MISSING VALUES TAGGED BY THE VALUE SPVC. MULTIPLE C FILLING PASSES MAY BE MADE. WE OPTED TO MAKE ONE C PASS AND REPLACE ANY REMAINING SPVC VALUES BY THE C FIELD MEAN. C . C C PROGRAM HISTORY LOG: C ??-??-?? DAVID PLUMMER - SOURCE IN ETAPACKC C 93-02-26 RUSS TREADON - GENERALIZED ETAPACKC SOURCE C AND ADDED COMMENTS. C 93-06-23 RUSS TREADON - COMPLETE REWRITE. C C USAGE: CALL EXTEND(GRID,IDIM,JDIM,AVG,SPVC) C INPUT ARGUMENT LIST: C GRID - GRID TO BE FILLED. C IDIM - FIRST DIMENSION OF GRID. C JDIM - SECOND DIENSION OF GRID. C AVG - VALUE TO REPLACE SPVC VALUES WITH AFTER C MXPASS FILLING PASSES OVER THE GRID. C SPVC - THE MISSING DATA FLAG. C C OUTPUT ARGUMENT LIST: C GRID - GRID WITH SPVC VALUES REPLACED BY EXTENDED C BORDER VALUES OR PASSED VALUE OF AVG. C C OUTPUT FILES: C STDOUT - RUN TIME STANDARD OUT. C C SUBPROGRAMS CALLED: C UTILITIES: C NONE C LIBRARY: C COMMON - IOUNIT C C ATTRIBUTES: C LANGUAGE: FORTRAN C MACHINE : CRAY C-90 C$$$ C C C C SET PARAMETERS PARAMETER (MXPASS=1) C C DECLARE VARIABLES. REAL GRID(IDIM,JDIM) C C INCLUDE COMMON BLOCK INCLUDE "IOUNIT.comm" C C************************************************************************** C START EXTEND HERE. C print *,'EXTENDD ',idim,jdim IJDIM = IDIM*JDIM C C FILL MISSING VALUES WITH BOUNDARY VALUES. WE ALLOW C UP TO MXPASS EXTENSION PASSES TO ACCOMPLISH THIS. THE C COMMENTS BELOW ASSUME GRID(1,1) IS IN THE SOUTHWEST OR C LOWER LEFT CORNER AND GRID(IDIM,JDIM) IS IN THE NORTHEAST C OR UPPER RIGHT CORNER. C IPASS = 0 10 CONTINUE IPASS = IPASS + 1 C C EXTEND SOUTHERN AND NORTHERN BOUNDARIES. DO 70 I = 1,IDIM C C EXTEND SOUTHERN BOUNDARY. DO 30 J = 1,JDIM IF (GRID(I,J).NE.SPVC) THEN DO 20 JJ = J,1,-1 GRID(I,JJ) = GRID(I,J) 20 CONTINUE GOTO 40 ENDIF 30 CONTINUE C C EXTEND NORTHERN BOUNDARY 40 CONTINUE DO 60 J = JDIM,1,-1 IF (GRID(I,J).NE.SPVC) THEN DO 50 JJ = J,JDIM GRID(I,JJ) = GRID(I,J) 50 CONTINUE GOTO 70 ENDIF 60 CONTINUE C C REPEAT FOR NEXT COLUMN. 70 CONTINUE C C EXTEND WESTERN AND EASTERN BOUNDARIES DO 170 J = 1,JDIM C C EXTEND WESTERN BOUNDARY DO 130 I = 1,IDIM IF (GRID(I,J).NE.SPVC) THEN DO 120 II = I,1,-1 GRID(II,J) = GRID(I,J) 120 CONTINUE GOTO 140 ENDIF 130 CONTINUE C C EXTEND EASTERN BOUNDARY 140 CONTINUE DO 160 I = IDIM,1,-1 IF (GRID(I,J).NE.SPVC) THEN DO 150 II = I,IDIM GRID(II,J) = GRID(I,J) 150 CONTINUE GOTO 170 ENDIF 160 CONTINUE C C REPEAT FOR NEXT ROW 170 CONTINUE C C SEE IF WE NEED TO MAKE ANOTHER PASS. C CALL MINMAX(GRID,IDIM,JDIM,FMIN,FMAX) IF (FMAX.GE.SPVC) THEN CX WRITE(STDOUT,*)'EXTEND: BOUNDARY FILL: ',IPASS,FMIN,FMAX IF (IPASS.LT.MXPASS) GOTO 10 ENDIF C C IF WE STILL CAN'T FILL THE GRID AFTER MXPASS PASSES, C FILL MISSING VALUES WITH FIELD MEAN. C IF ((FMAX.GE.SPVC).AND.(IPASS.GE.MXPASS)) THEN CX WRITE(STDOUT,*)'EXTEND: FILLING WITH AVG=',AVG !$omp parallel do DO 180 J = 1,JDIM DO 180 I = 1,IDIM IF (GRID(I,J).GE.SPVC) GRID(I,J) = AVG 180 CONTINUE ENDIF print*,'At the end of EXTEND' C C END OF ROUTINE. C RETURN END