$ IF ( .NOT. monotonic( Pos%sz, Pos%NSz ) ) THEN $ CALL ERROUT( 'SzRzRMod', 'Source depths are not monotonically increasing' ) $ END IF $ $ IF ( .NOT. monotonic( Pos%rz, Pos%NRz ) ) THEN $ CALL ERROUT( 'SzRzRMod', 'Receiver depths are not monotonically increasing' ) $ END IF
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real, | intent(in) | :: | zMin | |||
real, | intent(in) | :: | zMax |
SUBROUTINE ReadSzRz( zMin, zMax ) ! Reads source and receiver z-coordinates (depths) ! zMin and zMax are limits for those depths; sources and receivers are shifted to be within those limits REAL, INTENT( IN ) :: zMin, zMax !LOGICAL :: monotonic CALL ReadVector( Pos%NSz, Pos%Sz, 'Source z-coordinates, Sz', 'm' ) CALL ReadVector( Pos%NRz, Pos%Rz, 'Receiver z-coordinates, Rz', 'm' ) IF ( ALLOCATED( Pos%ws ) ) DEALLOCATE( Pos%ws, Pos%iSz ) ALLOCATE( Pos%ws( Pos%NSz ), Pos%iSz( Pos%NSz ), Stat = IAllocStat ) IF ( IAllocStat /= 0 ) CALL ERROUT( 'ReadSzRz', 'Too many sources' ) IF ( ALLOCATED( Pos%wr ) ) DEALLOCATE( Pos%wr, Pos%iRz ) ALLOCATE( Pos%wr( Pos%NRz ), Pos%iRz( Pos%NRz ), Stat = IAllocStat ) IF ( IAllocStat /= 0 ) CALL ERROUT( 'ReadSzRz', 'Too many receivers' ) ! *** Check for Sz/Rz in upper or lower halfspace *** IF ( ANY( Pos%Sz( 1 : Pos%NSz ) < zMin ) ) THEN WHERE ( Pos%Sz < zMin ) Pos%Sz = zMin WRITE( PRTFile, * ) 'Warning in ReadSzRz : Source above or too near the top bdry has been moved down' END IF IF ( ANY( Pos%Sz( 1 : Pos%NSz ) > zMax ) ) THEN WHERE( Pos%Sz > zMax ) Pos%Sz = zMax WRITE( PRTFile, * ) 'Warning in ReadSzRz : Source below or too near the bottom bdry has been moved up' END IF IF ( ANY( Pos%Rz( 1 : Pos%NRz ) < zMin ) ) THEN WHERE( Pos%Rz < zMin ) Pos%Rz = zMin WRITE( PRTFile, * ) 'Warning in ReadSzRz : Receiver above or too near the top bdry has been moved down' END IF IF ( ANY( Pos%Rz( 1 : Pos%NRz ) > zMax ) ) THEN WHERE( Pos%Rz > zMax ) Pos%Rz = zMax WRITE( PRTFile, * ) 'Warning in ReadSzRz : Receiver below or too near the bottom bdry has been moved up' END IF !!$ IF ( .NOT. monotonic( Pos%sz, Pos%NSz ) ) THEN !!$ CALL ERROUT( 'SzRzRMod', 'Source depths are not monotonically increasing' ) !!$ END IF !!$ !!$ IF ( .NOT. monotonic( Pos%rz, Pos%NRz ) ) THEN !!$ CALL ERROUT( 'SzRzRMod', 'Receiver depths are not monotonically increasing' ) !!$ END IF RETURN END SUBROUTINE ReadSzRz