!! $$ main program documentation block ! ! MODULE : fillup ! PRGMMR: BIJU THOMAS, URI/GSO, 2014-09-03 ! LANG: FORTRAN 90/95 ! MODULE fillupmd USE varsmd, ONLY : im, jm, nl IMPLICIT NONE CONTAINS SUBROUTINE fillup(largetval, zrtof, h, t, s) REAL, INTENT(IN) :: largetval REAL, INTENT(IN), DIMENSION(nl) :: zrtof REAL, INTENT(IN), DIMENSION(im, jm) :: h REAL, INTENT(INOUT), DIMENSION(im, jm, nl) :: t, s INTEGER :: i, j, k, n, ip, jp, in, jn, allo_err INTEGER, PARAMETER :: npts = 5 DO k = 2, nl DO j = 1, jm DO i = 1, im IF( zrtof(k) <= h(i,j) .AND. h(i,j) /= largetval) THEN IF ( (t(i,j,k) == largetval .AND. s(i,j,k) /= largetval) .OR. & (t(i,j,k) /= largetval .AND. s(i,j,k) == largetval) ) & PRINT*, ' MISMATCH BETWEEN T & S (fillupmd) ' IF ( t(i,j,k) == largetval .AND. t(i,j,k-1) /= largetval) THEN DO n = 1, npts ip = min(i+n,im) jp = min(j+n,jm) in = max(1, i-n) jn = max(1, j-n) IF ( t(ip,j,k) /= largetval .AND. t(ip,j,k) <= t(i,j,k-1) ) THEN t(i,j,k) = t(ip,j,k) s(i,j,k) = s(ip,j,k) EXIT ELSE IF (t(i,jp,k) /= largetval .AND. t(i,jp,k) <= t(i,j,k-1)) THEN t(i,j,k) = t(i,jp,k) s(i,j,k) = s(i,jp,k) EXIT ELSE IF( t(in,j,k) /= largetval .AND. t(in,j,k) <= t(i,j,k-1) ) THEN t(i,j,k) = t(in,j,k) s(i,j,k) = s(in,j,k) EXIT ELSE IF( t(i,jn,k) /= largetval .AND. t(i,jn,k) <= t(i,j,k-1)) THEN t(i,j,k) = t(i,jn,k) s(i,j,k) = s(i,jn,k) EXIT ENDIF ENDDO ENDIF ENDIF ENDDO ENDDO ENDDO END SUBROUTINE fillup END MODULE fillupmd