/[MITgcm]/MITgcm/pkg/exf/exf_set_evap.F
ViewVC logotype

Diff of /MITgcm/pkg/exf/exf_set_evap.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by dimitri, Fri Dec 27 08:01:55 2002 UTC revision 1.1.2.1 by dimitri, Fri Dec 27 08:01:55 2002 UTC
# Line 0  Line 1 
1    #include "EXF_CPPOPTIONS.h"
2    
3          subroutine exf_set_evap( mycurrenttime, mycurrentiter, mythid )
4    
5    c     ==================================================================
6    c     SUBROUTINE exf_set_evap
7    c     ==================================================================
8    c
9    c     o set external forcing evap
10    c
11    c     started: Ralf.Giering@FastOpt.de 25-Mai-2000
12    c     changed: heimbach@mit.edu 10-Jan-2002
13    
14    c     ==================================================================
15    c     SUBROUTINE exf_set_evap
16    c     ==================================================================
17    
18          implicit none
19    
20    c     == global variables ==
21    
22    #include "EEPARAMS.h"
23    #include "SIZE.h"
24    #include "GRID.h"
25    
26    #include "exf_param.h"
27    #include "exf_constants.h"
28    #include "exf_fields.h"
29    
30    c     == routine arguments ==
31    
32          _RL     mycurrenttime
33          integer mycurrentiter
34          integer mythid
35    
36    #ifdef EXF_READ_EVAP
37    c     == local variables ==
38    
39          logical first, changed
40          integer count0, count1
41          _RL     fac
42    
43          integer bi, bj
44          integer i, j
45    
46    c     == end of interface ==
47    
48    c     get record numbers and interpolation factor for evap
49          call exf_GetFFieldRec(
50         I                       evapstartdate, evapperiod
51         O                     , fac, first, changed
52         O                     , count0, count1
53         I                     , mycurrenttime, mycurrentiter, mythid
54         &                     )
55    
56          if ( first ) then
57            if ( evapfile .NE. ' ' )
58         &        call mdsreadfield( evapfile, exf_iprec, exf_yftype, 1
59         &                   , evap1, count0, mythid
60         &                   )
61            if (exf_yftype .eq. 'RL') then
62               call exf_filter_rl( evap1, evapmask, mythid )
63            else
64               call exf_filter_rs( evap1, evapmask, mythid )
65            end if
66          endif
67    
68          if (( first ) .or. ( changed )) then
69            call exf_SwapFFields( evap0, evap1, mythid )
70    
71            if ( evapfile .NE. ' ' )
72         &       call mdsreadfield( evapfile, exf_iprec, exf_yftype, 1
73         &                   , evap1, count1, mythid
74         &                   )
75            if (exf_yftype .eq. 'RL') then
76               call exf_filter_rl( evap1, evapmask, mythid )
77            else
78               call exf_filter_rs( evap1, evapmask, mythid )
79            end if
80          endif
81    
82    c     Loop over tiles.
83          do bj = mybylo(mythid),mybyhi(mythid)
84            do bi = mybxlo(mythid),mybxhi(mythid)
85              do j = 1,sny
86                do i = 1,snx
87    
88    c             Interpolate linearly onto the current time.
89    
90                  evap(i,j,bi,bj) = fac          *evap0(i,j,bi,bj)+
91         &                          (exf_one - fac) *evap1(i,j,bi,bj)
92    
93                enddo
94              enddo
95            enddo
96          enddo
97    
98    #endif EXF_READ_EVAP
99    
100          end
101    
102    
103    
104          subroutine exf_init_evap( mythid )
105    
106    c     ==================================================================
107    c     SUBROUTINE exf_init_evap
108    c     ==================================================================
109    c
110    c     o
111    c
112    c     started: Ralf.Giering@FastOpt.de 25-Mai-2000
113    c     changed: heimbach@mit.edu 10-Jan-2002
114    c
115    c     ==================================================================
116    c     SUBROUTINE exf_init_evap
117    c     ==================================================================
118    
119          implicit none
120    
121    c     == global variables ==
122    
123    #include "EEPARAMS.h"
124    #include "SIZE.h"
125    
126    #include "exf_param.h"
127    #include "exf_fields.h"
128    
129    c     == routine arguments ==
130    
131          integer mythid
132    
133    #ifdef EXF_READ_EVAP
134    c     == local variables ==
135    
136          integer bi, bj
137          integer i, j
138    
139    c     == end of interface ==
140    
141          do bj = mybylo(mythid), mybyhi(mythid)
142            do bi = mybxlo(mythid), mybxhi(mythid)
143              do j = 1, sny
144                do i = 1, snx
145                  evap(i,j,bi,bj)  = 0. _d 0
146                  evap0(i,j,bi,bj) = 0. _d 0
147                  evap1(i,j,bi,bj) = 0. _d 0
148                enddo
149              enddo
150            enddo
151          enddo
152    
153    #endif EXF_READ_EVAP
154    
155          end
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.2.1
  ViewVC Help
Powered by ViewVC 1.1.22