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

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

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


Revision 1.8 - (show annotations) (download)
Thu Aug 7 02:31:29 2003 UTC (20 years, 9 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint51f_pre
Changes since 1.7: +3 -3 lines
o Added on-the-fly spatial interpolation capability
    "USE_EXF_INTERPOLATION" to pkg/exf.
  - This is a temporary Cartesian-grid hack until
    the super-duper ESMF coupler becomes available.
  - See verification/global_with_exf/README for usage example.
  - Removed obsolete EXFwindOnBgrid and SEAICEwindOnCgrid
    flags and modified pkg/seaice accordingly.
o Bug fix to pkg/ptracers, pkg/generic_advdiff/gad_calc_rhs.F,
    and pkg/kpp/kpp_transport_ptr.F for dealing with tracer
    non-local transport term.

1 c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_climsst.F,v 1.7 2003/08/04 22:53:42 dimitri Exp $
2
3 #include "EXF_CPPOPTIONS.h"
4
5
6 subroutine exf_set_climsst(
7 O mycurrenttime
8 I , mycurrentiter
9 I , mythid
10 & )
11
12 c ==================================================================
13 c SUBROUTINE exf_set_climsst
14 c ==================================================================
15 c
16 c o Get the current climatological sea surface salinity field.
17 c started: Christian Eckert eckert@mit.edu 27-Aug-1999
18 c changed: Christian Eckert eckert@mit.edu 11-Jan-2000
19 c - Restructured the code in order to create a package
20 c for the MITgcmUV.
21 c Christian Eckert eckert@mit.edu 12-Feb-2000
22 c - Changed Routine names (package prefix: exf_)
23 c changed: heimbach@mit.edu 08-Feb-2002
24 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
25 c
26 c ==================================================================
27 c SUBROUTINE exf_set_climsst
28 c ==================================================================
29
30 implicit none
31
32 #include "EEPARAMS.h"
33 #include "SIZE.h"
34 #include "GRID.h"
35
36 #include "exf_param.h"
37 #include "exf_constants.h"
38 #include "exf_clim_param.h"
39 #include "exf_clim_fields.h"
40
41 c == routine arguments ==
42
43 _RL mycurrenttime
44 integer mycurrentiter
45 integer mythid
46
47 #ifdef ALLOW_CLIMSST_RELAXATION
48
49 c == local variables ==
50
51 logical first, changed
52 integer count0, count1
53 _RL fac
54
55 integer bi, bj
56 integer i, j
57
58 c == end of interface ==
59
60 if ( climsstfile .NE. ' ' ) then
61
62 #ifdef ALLOW_CLIM_CYCLIC
63 c record numbers are assumed 1 to 12 corresponding to
64 c Jan. through Dec.
65 call cal_GetMonthsRec(
66 O fac, first, changed,
67 O count0, count1,
68 I mycurrenttime, mycurrentiter, mythid
69 & )
70 #else
71 c get record numbers and interpolation factor for climsst
72 call exf_GetFFieldRec(
73 I climsststartdate, climsstperiod
74 O , fac, first, changed
75 O , count0, count1
76 I , mycurrenttime, mycurrentiter, mythid
77 & )
78 #endif
79
80 if ( first ) then
81 #ifdef USE_EXF_INTERPOLATION
82 call exf_interp(
83 & climsstfile, exf_clim_iprec
84 & , climsst1, count0, xC, yC
85 & ,climsst_lon0,climsst_lon_inc
86 & ,climsst_lat0,climsst_lat_inc
87 & ,climsst_nlon,climsst_nlat,mythid )
88 #else
89 call mdsreadfield( climsstfile, exf_clim_iprec
90 & , exf_clim_yftype, 1
91 & , climsst1, count0, mythid
92 & )
93 #endif
94 if (exf_clim_yftype .eq. 'RL') then
95 call exf_filter_rl( climsst1, climsstmask, mythid )
96 else
97 call exf_filter_rs( climsst1, climsstmask, mythid )
98 end if
99 endif
100
101 if (( first ) .or. ( changed )) then
102 call exf_SwapFFields( climsst0, climsst1, mythid )
103
104 #ifdef USE_EXF_INTERPOLATION
105 call exf_interp(
106 & climsstfile, exf_iprec
107 & , climsst1, count1, xC, yC
108 & ,climsst_lon0,climsst_lon_inc
109 & ,climsst_lat0,climsst_lat_inc
110 & ,climsst_nlon,climsst_nlat,mythid )
111 #else
112 call mdsreadfield( climsstfile, exf_clim_iprec
113 & , exf_clim_yftype, 1
114 & , climsst1, count1, mythid
115 & )
116 #endif
117 if (exf_clim_yftype .eq. 'RL') then
118 call exf_filter_rl( climsst1, climsstmask, mythid )
119 else
120 call exf_filter_rs( climsst1, climsstmask, mythid )
121 end if
122 endif
123
124 c Loop over tiles.
125 do bj = mybylo(mythid),mybyhi(mythid)
126 do bi = mybxlo(mythid),mybxhi(mythid)
127 do j = 1,sny
128 do i = 1,snx
129
130 c Set to freezing temperature if less
131 if (climsst0(i,j,bi,bj) .lt. climtempfreeze) then
132 climsst0(i,j,bi,bj) = climtempfreeze
133 endif
134 if (climsst1(i,j,bi,bj) .lt. climtempfreeze) then
135 climsst1(i,j,bi,bj) = climtempfreeze
136 endif
137
138 c Interpolate linearly onto the current time.
139 climsst(i,j,bi,bj) = exf_inscal_sst * (
140 & fac * climsst0(i,j,bi,bj) +
141 & (exf_one - fac) * climsst1(i,j,bi,bj) )
142
143 enddo
144 enddo
145 enddo
146 enddo
147
148 endif
149
150 #endif /* ALLOW_CLIMSST_RELAXATION */
151
152 end
153
154
155 subroutine exf_init_climsst(
156 I mythid
157 & )
158
159 c ==================================================================
160 c SUBROUTINE exf_init_climsst
161 c ==================================================================
162 c
163 c o
164 c
165 c started: Ralf.Giering@FastOpt.de 25-Mai-2000
166 c
167 c ==================================================================
168 c SUBROUTINE exf_init_climsst
169 c ==================================================================
170
171 implicit none
172
173 c == global variables ==
174
175 #include "EEPARAMS.h"
176 #include "SIZE.h"
177
178 #include "exf_fields.h"
179 #include "exf_param.h"
180 #include "exf_clim_param.h"
181 #include "exf_clim_fields.h"
182
183 c == routine arguments ==
184
185 integer mythid
186
187 #ifdef ALLOW_CLIMSST_RELAXATION
188
189 c == local variables ==
190
191 integer bi, bj
192 integer i, j
193
194 c == end of interface ==
195
196 do bj = mybylo(mythid), mybyhi(mythid)
197 do bi = mybxlo(mythid), mybxhi(mythid)
198 do j = 1, sny
199 do i = 1, snx
200 climsst (i,j,bi,bj) = climsstconst
201 climsst0(i,j,bi,bj) = 0. _d 0
202 climsst1(i,j,bi,bj) = 0. _d 0
203 enddo
204 enddo
205 enddo
206 enddo
207
208 #endif /* ALLOW_CLIMSSST_RELAXATION */
209
210 end

  ViewVC Help
Powered by ViewVC 1.1.22