Blame view

src/observations/get_w_adv.F90 3.81 KB
33b83817   dumoda01   Depot du modele /...
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
!$Id: get_w_adv.F90,v 1.8 2006-11-27 09:25:18 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_w_adv
!
! !INTERFACE:
   subroutine get_w_adv(method,unit,jul,secs)
!
! !DESCRIPTION:
!  This routine is responsible for providing sane values to `observed'
!  vertical velocity which will then be applied for vertical
!  advection of mean flow properties. A height and a vertical velocity value are
!  either set to constant values or read from a file. The height will be
!  assigned to be the position of maximum vertical velocity, and the
!  vertical profiles of vertical velocity will be then constructed in
!  such a way that the velocity is linearly decreasing away from this height,
!  with zero values at the surface and the bottom.
!  The subroutine is called in the {\tt get\_all\_obs()} subroutine
!  as part of the main integration loop.
!  In case of observations from file the temporal interpolation is
!  done in this routine.
!
! !USES:
   use time,         only: time_diff,julian_day
   use observations, only: init_saved_vars,read_obs
   use observations, only: w_adv,w_adv0,w_adv_height0,w_height
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
   integer, intent(in)                 :: method,unit,jul,secs
!
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding
!
!  $Log: get_w_adv.F90,v $
!  Revision 1.8  2006-11-27 09:25:18  kbk
!  use logical var init_saved_vars to initialise saved variables
!
!  Revision 1.7  2005/11/15 11:02:32  lars
!  documentation finish for print
!
!  Revision 1.6  2005/08/15 11:54:01  hb
!  sequence of reading w_adv and w_height changed, 
!  w_adv_height0 introduced, documentation extended
!
!  Revision 1.5  2005/06/27 13:44:07  kbk
!  modified + removed traling blanks
!
!  Revision 1.4  2003/03/28 09:20:35  kbk
!  added new copyright to files
!
!  Revision 1.3  2003/03/28 09:02:09  kbk
!  removed tabs
!
!  Revision 1.2  2003/03/10 08:51:57  gotm
!  Improved documentation and cleaned up code
!
!  Revision 1.1.1.1  2001/02/12 15:55:58  gotm
!  initial import into CVS
!
!EOP
!
! !LOCAL VARIABLES:
   integer                   :: yy,mm,dd,hh,min,ss
   REALTYPE                  :: t
   REALTYPE, save            :: dt
   integer, save             :: jul1,secs1
   integer, save             :: jul2=0,secs2=0
   REALTYPE, save            :: alpha(2)
   REALTYPE, save            :: obs1(2),obs2(2)=0.
   integer                   :: rc
!
!-----------------------------------------------------------------------
!BOC
   if (init_saved_vars) then
      jul2=0
      secs2=0
      obs2(2)=0.
   end if

   select case(method)
      case(0)                               ! no vertical advection
         w_adv = _ZERO_
      case(1)
         w_height = w_adv_height0
         w_adv    = w_adv0
      case(2)                               ! from file
!        This part initialises and reads in new values if necessary.
         if(time_diff(jul2,secs2,jul,secs) .lt. 0) then
            do
               jul1 = jul2
               secs1 = secs2
               obs1 = obs2
               call read_obs(unit,yy,mm,dd,hh,min,ss,2,obs2,rc)
               call julian_day(yy,mm,dd,jul2)
               secs2 = hh*3600 + min*60 + ss
               if(time_diff(jul2,secs2,jul,secs) .gt. 0) EXIT
            end do
            dt = time_diff(jul2,secs2,jul1,secs1)
            alpha = (obs2-obs1)/dt
         end if

!        Do the time interpolation
         t  = time_diff(jul,secs,jul1,secs1)

         w_height = obs1(1) + t*alpha(1)
         w_adv    = obs1(2) + t*alpha(2)

      case default
   end select

   return
   end subroutine get_w_adv
!EOC

!-----------------------------------------------------------------------
! Copyright by the GOTM-team under the GNU Public License - www.gnu.org
!-----------------------------------------------------------------------