sinter.f90

Go to the documentation of this file.

!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

!==============================================================================|
!                                                                          |
!  this subroutine linearly interpolates and extrapolates an               | 
!  array b.                                                                |
!                                                                          |
!  x(m1) must be descending                                                    |
!  a(x) given function                                                     |
!  b(y) found by linear interpolation and extrapolation                    |    
!  y(n1) the desired depths                                                |    
!  m1   the number of points in x and a                                    |    
!  n1   the number of points in y and b                                    |    
!                                                                              |    
!==============================================================================|

MODULE sinter
  IMPLICIT NONE

  CONTAINS

   SUBROUTINE sinter_extrp_up(X,A,Y,B,M1,N1)              

!==============================================================================|
   USE mod_prec
   IMPLICIT NONE
   INTEGER, INTENT(IN)   :: M1,N1
   REAL(SP), INTENT(IN)  :: X(M1),A(M1),Y(N1)
   REAL(SP), INTENT(OUT) :: B(N1) 
   INTEGER   I,J,NM
!==============================================================================|

!
!  EXTRAPOLATION
!
   DO i=1,n1
       IF (y(i) > x(1 )) b(i) = a(1) + ((a(1)-a(2))/(x(1)-x(2))) * (y(i)-x(1))
       IF (y(i) < x(m1)) b(i) = a(m1)
   END DO

!
!  INTERPOLATION
!
   nm = m1 - 1
   DO i=1,n1
     DO j=1,nm
        IF (y(i) <=  x(j) .AND. y(i) >= x(j+1)) &
              b(i) = a(j) - (a(j)- a(j+1)) * (x(j)-y(i)) / (x(j)-x(j+1))
     END DO
   END DO

   RETURN
 END SUBROUTINE sinter_extrp_up
!==============================================================================|

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!==============================================================================|
   SUBROUTINE sinter_extrp_down(X,A,Y,B,M1,N1)              
!  for baroclinic interpolation                                                |
!==============================================================================|


!==============================================================================|
   USE mod_prec
   IMPLICIT NONE
   INTEGER, INTENT(IN)  :: M1,N1
   REAL(SP),  INTENT(IN)  :: X(M1),A(M1),Y(N1)
   REAL(SP),  INTENT(OUT) :: B(N1) 
   INTEGER :: I,J,NM
!==============================================================================|

!
!  EXTRAPOLATION 
!
   DO i=1,n1
     IF(y(i) > x(1 )) b(i) = a(1)
     IF(y(i) < x(m1)) b(i)=a(m1)+(a(m1-1)-a(m1))*(y(i)-x(m1))/(x(m1-1)-x(m1))
   END DO

!
!  INTERPOLATION
!
   nm = m1 - 1
   DO i=1,n1
     DO j=1,nm
       IF (y(i)<=x(j).AND.y(i)>=x(j+1)) &
          b(i) = a(j) - (a(j)- a(j+1)) *(x(j)-y(i)) / (x(j)-x(j+1))
     END DO
   END DO

   RETURN
 END SUBROUTINE sinter_extrp_down
!==============================================================================|


!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!==============================================================================|
   SUBROUTINE sinter_extrp_none(X,A,Y,B,M1,N1)              
!  for t&s obc interpolation                                                   |
!==============================================================================|


   USE mod_prec
   IMPLICIT NONE
   INTEGER, INTENT(IN)  :: M1,N1
   REAL(SP),  INTENT(IN)  :: X(M1),A(M1),Y(N1)
   REAL(SP),  INTENT(OUT) :: B(N1) 
   INTEGER :: I,J,NM
!==============================================================================|


!
!   EXTRAPOLATION
!
   DO i=1,n1
     IF (y(i) > x(1 )) b(i) = a(1)
     IF (y(i) < x(m1)) b(i) = a(m1)
   END DO

!
!  INTERPOLATION
!
   nm = m1 - 1
   DO i=1,n1
     DO j=1,nm
       IF (y(i) <= x(j).AND.y(i) >= x(j+1))  &
       b(i) = a(j) - (a(j)- a(j+1)) * (x(j)-y(i)) / (x(j)-x(j+1))
     END DO
   END DO

   RETURN
 END SUBROUTINE sinter_extrp_none
!==============================================================================|

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!==============================================================================|
   SUBROUTINE sinter_extrp_both(X,A,Y,B,M1,N1)              
!==============================================================================|


!==============================================================================|
   USE mod_prec
   IMPLICIT NONE
   INTEGER, INTENT(IN)  :: M1,N1
   REAL(SP),  INTENT(IN)  :: X(M1),A(M1),Y(N1)
   REAL(SP),  INTENT(OUT) :: B(N1) 
   INTEGER :: I,J,NM
!==============================================================================|

!
!  EXTRAPOLATION 
!
   DO i=1,n1
     IF(y(i) > x(1 )) b(i) = a(1) + ((a(1)-a(2))/(x(1)-x(2))) * (y(i)-x(1))
     IF(y(i) < x(m1)) b(i)=a(m1)+(a(m1-1)-a(m1))*(y(i)-x(m1))/(x(m1-1)-x(m1))
   END DO

!
!  INTERPOLATION
!
   nm = m1 - 1
   DO i=1,n1
     DO j=1,nm
       IF (y(i)<=x(j).AND.y(i)>=x(j+1)) &
          b(i) = a(j) - (a(j)- a(j+1)) *(x(j)-y(i)) / (x(j)-x(j+1))
     END DO
   END DO

   RETURN
 END SUBROUTINE sinter_extrp_both
!==============================================================================|

END MODULE sinter