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

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

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

Revision 1.14 - (hide annotations) (download)
Tue Nov 8 15:53:41 2005 UTC (18 years, 6 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, checkpoint58b_post, checkpoint58m_post, checkpoint58r_post, checkpoint57y_post, checkpoint58g_post, checkpoint57x_post, checkpoint58n_post, checkpoint58h_post, checkpoint58j_post, checkpoint57y_pre, checkpoint58, checkpoint58f_post, checkpoint58d_post, checkpoint58a_post, checkpoint58i_post, checkpoint58o_post, checkpoint57z_post, checkpoint58c_post, checkpoint58k_post, checkpoint58s_post, checkpoint58p_post, checkpoint58q_post
Changes since 1.13: +3 -1 lines 
Changes toward getting exf working multi-threaded.
  o added some opitonal consistency check in barrier for
    trapping barrier calls in singel threaded region
  o removed a single thread block in ini_depths - singleCpuIO
    still broken.
  o modified parts of exf_ that were setting local stack variables
    in single threaded section and then referencing them from all
    threads.
  o commented out strange stop in mdsio for multithreading which
    seems uneeded.
  o fixed ptracers initialization and changed ptracers monitor
    to avoid race condition in which several threads set a shared
    logical flag at arbitrary moments with respect to each other
1 cnh 1.14 c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_climsst.F,v 1.13 2004/10/11 16:41:01 heimbach Exp $
2 heimbach 1.1
3 edhill 1.11 #include "EXF_OPTIONS.h"
4 heimbach 1.1
5    
6     subroutine exf_set_climsst(
7 heimbach 1.3 O mycurrenttime
8 heimbach 1.1 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 heimbach 1.3 c changed: heimbach@mit.edu 08-Feb-2002
24 dimitri 1.5 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
25 heimbach 1.1 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 heimbach 1.3 #include "exf_clim_fields.h"
40 heimbach 1.1
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 dimitri 1.9 integer bi, bj, i, j, interp_method
55 heimbach 1.13 integer year0, year1
56 heimbach 1.1
57     c == end of interface ==
58    
59 dimitri 1.5 if ( climsstfile .NE. ' ' ) then
60    
61 dimitri 1.12 if ( climsstperiod .EQ. 0 ) then
62    
63 heimbach 1.2 c record numbers are assumed 1 to 12 corresponding to
64     c Jan. through Dec.
65 dimitri 1.12 call cal_GetMonthsRec(
66     O fac, first, changed,
67     O count0, count1,
68     I mycurrenttime, mycurrentiter, mythid
69     & )
70    
71     else
72    
73 heimbach 1.1 c get record numbers and interpolation factor for climsst
74 heimbach 1.13
75 dimitri 1.12 call exf_GetFFieldRec(
76     I climsststartdate, climsstperiod
77 heimbach 1.13 I , climsststartdate1, climsststartdate2
78     I , .false.
79 dimitri 1.12 O , fac, first, changed
80 heimbach 1.13 O , count0, count1, year0, year1
81 dimitri 1.12 I , mycurrenttime, mycurrentiter, mythid
82     & )
83    
84     endif
85 heimbach 1.1
86 dimitri 1.5 if ( first ) then
87 dimitri 1.7 #ifdef USE_EXF_INTERPOLATION
88 cnh 1.14 _BARRIER
89 dimitri 1.9 interp_method = 2
90 dimitri 1.8 call exf_interp(
91 dimitri 1.7 & climsstfile, exf_clim_iprec
92     & , climsst1, count0, xC, yC
93     & ,climsst_lon0,climsst_lon_inc
94     & ,climsst_lat0,climsst_lat_inc
95 dimitri 1.9 & ,climsst_nlon,climsst_nlat,interp_method,mythid )
96 dimitri 1.7 #else
97 dimitri 1.5 call mdsreadfield( climsstfile, exf_clim_iprec
98     & , exf_clim_yftype, 1
99     & , climsst1, count0, mythid
100     & )
101 dimitri 1.7 #endif
102 dimitri 1.5 if (exf_clim_yftype .eq. 'RL') then
103     call exf_filter_rl( climsst1, climsstmask, mythid )
104     else
105     call exf_filter_rs( climsst1, climsstmask, mythid )
106     end if
107     endif
108    
109     if (( first ) .or. ( changed )) then
110     call exf_SwapFFields( climsst0, climsst1, mythid )
111 dimitri 1.7
112     #ifdef USE_EXF_INTERPOLATION
113 cnh 1.14 _BARRIER
114 dimitri 1.10 interp_method = 2
115 dimitri 1.8 call exf_interp(
116 dimitri 1.7 & climsstfile, exf_iprec
117     & , climsst1, count1, xC, yC
118     & ,climsst_lon0,climsst_lon_inc
119     & ,climsst_lat0,climsst_lat_inc
120 dimitri 1.9 & ,climsst_nlon,climsst_nlat,interp_method,mythid )
121 dimitri 1.7 #else
122 dimitri 1.5 call mdsreadfield( climsstfile, exf_clim_iprec
123     & , exf_clim_yftype, 1
124     & , climsst1, count1, mythid
125     & )
126 dimitri 1.7 #endif
127 dimitri 1.5 if (exf_clim_yftype .eq. 'RL') then
128     call exf_filter_rl( climsst1, climsstmask, mythid )
129     else
130     call exf_filter_rs( climsst1, climsstmask, mythid )
131     end if
132     endif
133 heimbach 1.1
134     c Loop over tiles.
135 dimitri 1.5 do bj = mybylo(mythid),mybyhi(mythid)
136     do bi = mybxlo(mythid),mybxhi(mythid)
137     do j = 1,sny
138     do i = 1,snx
139    
140     c Set to freezing temperature if less
141     if (climsst0(i,j,bi,bj) .lt. climtempfreeze) then
142     climsst0(i,j,bi,bj) = climtempfreeze
143     endif
144     if (climsst1(i,j,bi,bj) .lt. climtempfreeze) then
145     climsst1(i,j,bi,bj) = climtempfreeze
146     endif
147    
148     c Interpolate linearly onto the current time.
149     climsst(i,j,bi,bj) = exf_inscal_sst * (
150     & fac * climsst0(i,j,bi,bj) +
151     & (exf_one - fac) * climsst1(i,j,bi,bj) )
152 heimbach 1.1
153 dimitri 1.5 enddo
154     enddo
155 heimbach 1.1 enddo
156 dimitri 1.5 enddo
157    
158     endif
159 heimbach 1.1
160     #endif /* ALLOW_CLIMSST_RELAXATION */
161    
162     end
163    
164    
165     subroutine exf_init_climsst(
166     I mythid
167     & )
168    
169     c ==================================================================
170     c SUBROUTINE exf_init_climsst
171     c ==================================================================
172     c
173     c o
174     c
175     c started: Ralf.Giering@FastOpt.de 25-Mai-2000
176     c
177     c ==================================================================
178     c SUBROUTINE exf_init_climsst
179     c ==================================================================
180    
181     implicit none
182    
183     c == global variables ==
184    
185     #include "EEPARAMS.h"
186     #include "SIZE.h"
187    
188     #include "exf_fields.h"
189     #include "exf_param.h"
190     #include "exf_clim_param.h"
191     #include "exf_clim_fields.h"
192    
193     c == routine arguments ==
194    
195     integer mythid
196    
197     #ifdef ALLOW_CLIMSST_RELAXATION
198    
199     c == local variables ==
200    
201     integer bi, bj
202     integer i, j
203    
204     c == end of interface ==
205    
206     do bj = mybylo(mythid), mybyhi(mythid)
207     do bi = mybxlo(mythid), mybxhi(mythid)
208     do j = 1, sny
209     do i = 1, snx
210 heimbach 1.6 climsst (i,j,bi,bj) = climsstconst
211 heimbach 1.1 climsst0(i,j,bi,bj) = 0. _d 0
212     climsst1(i,j,bi,bj) = 0. _d 0
213     enddo
214     enddo
215     enddo
216     enddo
217    
218     #endif /* ALLOW_CLIMSSST_RELAXATION */
219    
220     end
  ViewVC Help
Powered by ViewVC 1.1.22