New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
obsinter_z1d.h90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago

set proper svn properties to all files...
  • Property svn:keywords set to Id
File size: 7.1 KB
Line 
1   SUBROUTINE obs_int_z1d( kpk, kkco, k1dint, kdep, &
2      &                    pobsdep, pobsk, pobs2k,  &
3      &                    pobs, pdep, pobsmask )
4      !!---------------------------------------------------------------------
5      !!
6      !!                   ***  ROUTINE obs_int_z1d ***
7      !!
8      !! ** Purpose : Vertical interpolation to the observation point.
9      !! 
10      !! ** Method  : If k1dint = 0 then use linear interpolation.
11      !!              If k1dint = 1 then use cubic spline interpolation.
12      !!
13      !! ** Action  :
14      !!
15      !! References :
16      !!
17      !! History
18      !!      ! 97-11 (A. Weaver, S. Ricci, N. Daget)
19      !!      ! 06-03 (G. Smith) Conversion to F90 for use with NEMOVAR
20      !!      ! 06-10 (A. Weaver) Cleanup
21      !!      ! 07-01 (K. Mogensen) Use profile rather than single level
22      !!---------------------------------------------------------------------
23
24      !! * Arguments
25      INTEGER, INTENT(IN) :: kpk        ! Number of vertical levels
26      INTEGER, INTENT(IN) :: k1dint     ! 0 = linear; 1 = cubic spline interpolation
27      INTEGER, INTENT(IN) :: kdep       ! Number of levels in profile
28      INTEGER, INTENT(IN), DIMENSION(kdep) :: &
29         & kkco                 ! Array indicies for interpolation
30      REAL(KIND=wp), INTENT(IN), DIMENSION(kdep) :: &
31         & pobsdep              ! Depth of the observation
32      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
33         & pobsk,  &            ! Model profile at a given (lon,lat)
34         & pobs2k, &            ! 2nd derivative of the interpolating function
35         & pdep,   &            ! Model depth array
36         & pobsmask             ! Vertical mask
37      REAL(KIND=wp), INTENT(OUT), DIMENSION(kdep) :: &
38         & pobs                 ! Model equivalent at observation point
39 
40      !! * Local declarations
41      REAL(KIND=wp) :: z1dm       ! Distance above and below obs to model grid points
42      REAL(KIND=wp) :: z1dp         
43      REAL(KIND=wp) :: zsum       ! Dummy variables for computation
44      REAL(KIND=wp) :: zsum2
45      INTEGER :: jdep             ! Observation depths loop variable
46   
47      !------------------------------------------------------------------------
48      ! Loop over all observation depths
49      !------------------------------------------------------------------------
50
51      DO jdep = 1, kdep
52
53         !---------------------------------------------------------------------
54         ! Initialization
55         !---------------------------------------------------------------------
56         z1dm = ( pdep(kkco(jdep)) - pobsdep(jdep)      )
57         z1dp = ( pobsdep(jdep)    - pdep(kkco(jdep)-1) )
58         IF ( pobsmask(kkco(jdep)) == 0.0_wp ) z1dp = 0.0_wp
59
60         zsum = z1dm + z1dp
61         
62         IF ( k1dint == 0 ) THEN
63
64            !-----------------------------------------------------------------
65            !  Linear interpolation
66            !-----------------------------------------------------------------
67            pobs(jdep) = (   z1dm * pobsk(kkco(jdep)-1) &
68               &           + z1dp * pobsk(kkco(jdep)  ) ) / zsum
69
70         ELSEIF ( k1dint == 1 ) THEN
71
72            !-----------------------------------------------------------------
73            ! Cubic spline interpolation
74            !-----------------------------------------------------------------
75            zsum2 = zsum * zsum
76            pobs(jdep)  = (  z1dm                             * pobsk (kkco(jdep)-1) &
77               &           + z1dp                             * pobsk (kkco(jdep)  ) &
78               &           + ( z1dm * ( z1dm * z1dm - zsum2 ) * pobs2k(kkco(jdep)-1) &
79               &           +   z1dp * ( z1dp * z1dp - zsum2 ) * pobs2k(kkco(jdep)  ) &
80               &             ) / 6.0_wp                                              &
81               &          ) / zsum
82
83         ENDIF
84      END DO
85
86   END SUBROUTINE obs_int_z1d
87
88   SUBROUTINE obs_int_z1d_spl( kpk, pobsk, pobs2k, &
89      &                        pdep, pobsmask )
90      !!--------------------------------------------------------------------
91      !!
92      !!                  *** ROUTINE obs_int_z1d_spl ***
93      !!
94      !! ** Purpose : Compute the local vector of vertical second-derivatives
95      !!              of the interpolating function used with a cubic spline.
96      !! 
97      !! ** Method  :
98      !!
99      !!    Top and bottom boundary conditions on the 2nd derivative are
100      !!    set to zero.
101      !!
102      !! ** Action  :
103      !!
104      !! References :
105      !!
106      !! History
107      !!      ! 01-11 (A. Weaver, S. Ricci, N. Daget)
108      !!      ! 06-03 (G. Smith) Conversion to F90 for use with NEMOVAR
109      !!      ! 06-10 (A. Weaver) Cleanup
110      !!----------------------------------------------------------------------
111     
112      !! * Arguments
113      INTEGER, INTENT(IN) :: kpk               ! Number of vertical levels
114      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
115         & pobsk, &          ! Model profile at a given (lon,lat)
116         & pdep,  &          ! Model depth array
117         & pobsmask          ! Vertical mask
118      REAL(KIND=wp), INTENT(OUT), DIMENSION(kpk) :: &
119         & pobs2k            ! 2nd derivative of the interpolating function
120 
121      !! * Local declarations
122      INTEGER :: jk
123      REAL(KIND=wp) :: za
124      REAL(KIND=wp) :: zb
125      REAL(KIND=wp) :: zc
126      REAL(KIND=wp) :: zpa
127      REAL(KIND=wp) :: zkm
128      REAL(KIND=wp) :: zkp
129      REAL(KIND=wp) :: zk
130      REAL(KIND=wp), DIMENSION(kpk-1) :: &
131         & zs, &
132         & zp, &
133         & zu, &
134         & zv
135
136      !-----------------------------------------------------------------------
137      ! Matrix initialisation
138      !-----------------------------------------------------------------------
139      zs(1) =  0.0_wp
140      zp(1) =  0.0_wp
141      zv(1) = -0.5_wp
142      DO jk = 2, kpk-1
143         zs(jk) =  ( pdep(jk  ) - pdep(jk-1) ) &
144            &    / ( pdep(jk+1) - pdep(jk-1) )
145         zp(jk) = zs(jk) * zv(jk-1) + 2.0_wp
146         zv(jk) = ( zs(jk) - 1.0_wp ) / zp(jk)
147      END DO
148 
149      !-----------------------------------------------------------------------
150      ! Solution of the tridiagonal system
151      !-----------------------------------------------------------------------
152 
153      ! Top boundary condition
154      zu(1) = 0.0_wp
155 
156      DO jk = 2, kpk-1
157         za = pdep(jk+1) - pdep(jk-1)
158         zb = pdep(jk+1) - pdep(jk  )
159         zc = pdep(jk  ) - pdep(jk-1)
160 
161         zpa = 6.0_wp / ( zp(jk) * za )
162         zkm = zpa / zc
163         zkp = zpa / zb
164         zk  = - ( zkm + zkp )
165 
166         zu(jk) =  pobsk(jk+1) * zkp  &
167            &    + pobsk(jk  ) * zk   &
168            &    + pobsk(jk-1) * zkm  &
169            &    + zu(jk-1) * ( -zs(jk) / zp(jk) )
170      END DO
171 
172      !-----------------------------------------------------------------------
173      ! Second derivative
174      !-----------------------------------------------------------------------
175      pobs2k(kpk) = 0.0_wp
176 
177      ! Bottom boundary condition
178      DO jk = kpk-1, 1, -1
179         pobs2k(jk) = zv(jk) * pobs2k(jk+1) + zu(jk)
180         IF ( pobsmask(jk+1) == 0.0_wp ) pobs2k(jk) = 0.0_wp
181      END DO
182 
183  END SUBROUTINE obs_int_z1d_spl
184
185
Note: See TracBrowser for help on using the repository browser.