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

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

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


Revision 1.1.2.3 - (show annotations) (download)
Sun Feb 9 16:27:56 2003 UTC (21 years, 5 months ago) by dimitri
Branch: release1
CVS Tags: release1_p12_pre
Changes since 1.1.2.2: +44 -42 lines
Modified pkg/exf/exf_set_* so that they work properly
when no input files are specified.

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 mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-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 if ( evapfile .NE. ' ' ) then
49
50 c get record numbers and interpolation factor for evap
51 call exf_GetFFieldRec(
52 I evapstartdate, evapperiod
53 O , fac, first, changed
54 O , count0, count1
55 I , mycurrenttime, mycurrentiter, mythid
56 & )
57
58 if ( first ) then
59 call mdsreadfield( evapfile, exf_iprec, exf_yftype, 1
60 & , evap1, count0, mythid
61 & )
62 if (exf_yftype .eq. 'RL') then
63 call exf_filter_rl( evap1, evapmask, mythid )
64 else
65 call exf_filter_rs( evap1, evapmask, mythid )
66 end if
67 endif
68
69 if (( first ) .or. ( changed )) then
70 call exf_SwapFFields( evap0, evap1, mythid )
71
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
99
100 #endif
101
102 end
103
104
105
106 subroutine exf_init_evap( mythid )
107
108 c ==================================================================
109 c SUBROUTINE exf_init_evap
110 c ==================================================================
111 c
112 c o
113 c
114 c started: Ralf.Giering@FastOpt.de 25-Mai-2000
115 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
116 c
117 c ==================================================================
118 c SUBROUTINE exf_init_evap
119 c ==================================================================
120
121 implicit none
122
123 c == global variables ==
124
125 #include "EEPARAMS.h"
126 #include "SIZE.h"
127
128 #include "exf_param.h"
129 #include "exf_fields.h"
130
131 c == routine arguments ==
132
133 integer mythid
134
135 #ifdef EXF_READ_EVAP
136 c == local variables ==
137
138 integer bi, bj
139 integer i, j
140
141 c == end of interface ==
142
143 do bj = mybylo(mythid), mybyhi(mythid)
144 do bi = mybxlo(mythid), mybxhi(mythid)
145 do j = 1, sny
146 do i = 1, snx
147 evap(i,j,bi,bj) = 0. _d 0
148 evap0(i,j,bi,bj) = 0. _d 0
149 evap1(i,j,bi,bj) = 0. _d 0
150 enddo
151 enddo
152 enddo
153 enddo
154
155 #endif
156
157 end

  ViewVC Help
Powered by ViewVC 1.1.22