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

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

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


Revision 1.22 - (show annotations) (download)
Mon Jan 6 14:52:38 2014 UTC (10 years, 5 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint65, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65t, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e
Changes since 1.21: +165 -111 lines
 - fix a small bug again (originally found by Wentao Liu, now found again)
 - streamline error output, ie. replace raw stop statements with
   regular print_error sequence
 - unify uppercase spelling and indentation

1 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_check.F,v 1.21 2013/04/20 21:37:28 dimitri Exp $
2 C $Name: $
3
4 #include "EXF_OPTIONS.h"
5
6 SUBROUTINE EXF_CHECK( myThid )
7
8 c ==================================================================
9 c SUBROUTINE EXF_CHECK
10 c ==================================================================
11 c
12 IMPLICIT NONE
13
14 c == global variables ==
15
16 #include "EEPARAMS.h"
17 #include "SIZE.h"
18 #include "PARAMS.h"
19
20 #include "EXF_PARAM.h"
21 #include "EXF_CONSTANTS.h"
22 c == routine arguments ==
23
24 c myThid - thread number for this instance of the routine.
25
26 INTEGER myThid
27
28 c == local variables ==
29
30 C msgBuf :: Informational/error message buffer
31 CHARACTER*(MAX_LEN_MBUF) msgBuf
32
33 c == end of interface ==
34
35 c check for consistency
36 IF (.NOT.
37 & (exf_iprec.EQ.precFloat32 .OR. exf_iprec.EQ.precFloat64)
38 & ) THEN
39 WRITE(msgBuf,'(A)')
40 & 'S/R EXF_CHECK: value of exf_iprec not allowed'
41 CALL PRINT_ERROR( msgBuf, myThid )
42 STOP 'ABNORMAL END: S/R EXF_CHECK'
43 ENDIF
44
45 IF (repeatPeriod.lt.0.) THEN
46 WRITE(msgBuf,'(A)')
47 & 'S/R EXF_CHECK: repeatPeriod must be positive'
48 CALL PRINT_ERROR( msgBuf, myThid )
49 STOP 'ABNORMAL END: S/R EXF_CHECK'
50 ENDIF
51
52 IF (useExfYearlyFields.and.repeatPeriod.ne.0.) THEN
53 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: The use of ',
54 $ 'useExfYearlyFields AND repeatPeriod is not implemented'
55 CALL PRINT_ERROR( msgBuf, myThid )
56 STOP 'ABNORMAL END: S/R EXF_CHECK'
57 ENDIF
58
59 #ifdef ALLOW_BULKFORMULAE
60 IF ( useAtmWind ) THEN
61 IF ( ustressfile .NE. ' ' .OR. vstressfile .NE. ' ' ) THEN
62 WRITE(msgBuf,'(A)')
63 & 'S/R EXF_CHECK: use u,v_wind components but not wind-stress'
64 CALL PRINT_ERROR( msgBuf, myThid )
65 STOP 'ABNORMAL END: S/R EXF_CHECK'
66 ENDIF
67 ENDIF
68 #endif
69
70 IF ( .NOT.useAtmWind ) THEN
71 IF ( uwindfile .NE. ' ' .OR. vwindfile .NE. ' ' ) THEN
72 WRITE(msgBuf,'(A)')
73 & 'S/R EXF_CHECK: read-in wind-stress but not u,v_wind components'
74 CALL PRINT_ERROR( msgBuf, myThid )
75 STOP 'ABNORMAL END: S/R EXF_CHECK'
76 ENDIF
77 ENDIF
78
79 #ifndef ALLOW_ZENITHANGLE
80 IF ( useExfZenAlbedo .OR. useExfZenIncoming .OR.
81 & select_ZenAlbedo .NE. 0 ) THEN
82 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: unsupported option',
83 & ' when ALLOW_ZENITHANGLE is not defined'
84 CALL PRINT_ERROR( msgBuf, myThid )
85 STOP 'ABNORMAL END: S/R EXF_CHECK'
86 ENDIF
87 #endif
88
89 #ifdef ALLOW_ZENITHANGLE
90 IF ( usingCartesianGrid .OR. usingCylindricalGrid ) THEN
91 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: ALLOW_ZENITHANGLE does ',
92 & 'not work for carthesian and cylindrical grids'
93 CALL PRINT_ERROR( msgBuf, myThid )
94 STOP 'ABNORMAL END: S/R EXF_CHECK'
95 ENDIF
96 IF ( select_ZenAlbedo.LT.0 .OR. select_ZenAlbedo.GT.3 ) THEN
97 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: unsupported ',
98 & 'select_ZenAlbedo choice'
99 CALL PRINT_ERROR( msgBuf, myThid )
100 STOP 'ABNORMAL END: S/R EXF_CHECK'
101 ENDIF
102 IF ( select_ZenAlbedo.EQ.2 .) THEN
103 WRITE(msgBuf,'(A,A)')
104 & 'S/R EXF_CHECK: *** WARNING *** for daily mean albedo, ',
105 & 'it is advised to use select_ZenAlbedo.EQ.1 instead of 2'
106 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
107 & SQUEEZE_RIGHT, myThid )
108 ENDIF
109 IF ( select_ZenAlbedo.GT.2 .AND. swdownperiod.GT. 21600 ) THEN
110 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: using diurnal albedo ',
111 & 'formula requires diurnal downward shortwave forcing'
112 CALL PRINT_ERROR( msgBuf, myThid )
113 STOP 'ABNORMAL END: S/R EXF_CHECK'
114 ENDIF
115 IF ( select_ZenAlbedo.GT.2 .AND. swdownperiod.GT. 3600 ) then
116 WRITE(msgBuf,'(A,A,A)')
117 & 'S/R EXF_CHECK: *** WARNING *** ',
118 & 'the diurnal albedo formula is likely not safe for such ',
119 & 'coarse temporal resolution downward shortwave forcing'
120 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
121 & SQUEEZE_RIGHT, myThid )
122 ENDIF
123 #endif
124
125 #ifdef USE_EXF_INTERPOLATION
126 IF ( climsstfile .NE. ' ' ) THEN
127 IF ( climsst_nlat .GT. MAX_LAT_INC ) THEN
128 WRITE(msgBuf,'(A)') 'S/R EXF_CHECK: climsst_nlat > MAX_LAT_INC'
129 CALL PRINT_ERROR( msgBuf, myThid )
130 STOP 'ABNORMAL END: S/R EXF_CHECK'
131 ENDIF
132 ENDIF
133 IF ( climsssfile .NE. ' ' ) THEN
134 IF ( climsss_nlat .GT. MAX_LAT_INC ) THEN
135 WRITE(msgBuf,'(A)') 'S/R EXF_CHECK: climsss_nlat > MAX_LAT_INC'
136 CALL PRINT_ERROR( msgBuf, myThid )
137 STOP 'ABNORMAL END: S/R EXF_CHECK'
138 ENDIF
139 ENDIF
140 IF ( usingCartesianGrid ) THEN
141 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: ',
142 & 'USE_EXF_INTERPOLATION assumes latitude/longitude'
143 CALL PRINT_ERROR( msgBuf, myThid )
144 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: ',
145 & 'input and output coordinates. Trivial to extend to'
146 CALL PRINT_ERROR( msgBuf, myThid )
147 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: ',
148 & 'cartesian coordinates, but has not yet been done.'
149 CALL PRINT_ERROR( msgBuf, myThid )
150 STOP 'ABNORMAL END: S/R EXF_CHECK'
151 ENDIF
152 C- some restrictions on 2-component vector field (might be relaxed later on)
153 IF ( ( uwind_interpMethod.GE.1 .AND. uwindfile.NE.' ' ) .OR.
154 & ( vwind_interpMethod.GE.1 .AND. vwindfile.NE.' ' ) ) THEN
155 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
156 IF ( uwind_interpMethod.EQ.0 .OR. uwindfile.EQ.' ' .OR.
157 & vwind_interpMethod.EQ.0 .OR. vwindfile.EQ.' ' ) THEN
158 C- stop if one expects interp+rotation (Curvilin-G) which will not happen
159 WRITE(msgBuf,'(A)')
160 & 'S/R EXF_CHECK: interp. needs 2 components (wind)'
161 CALL PRINT_ERROR( msgBuf, myThid )
162 STOP 'ABNORMAL END: S/R EXF_CHECK'
163 ENDIF
164 IF ( uwindstartdate .NE. vwindstartdate .OR.
165 & uwindperiod .NE. vwindperiod ) THEN
166 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: ',
167 & 'For CurvilinearGrid/RotatedGrid, the u and v wind '
168 CALL PRINT_ERROR( msgBuf, myThid )
169 WRITE(msgBuf,'(A,A,A)') 'S/R EXF_CHECK: ',
170 & 'files have to have the same startdate and period, ',
171 & 'because S/R EXF_SET_UV assumes that.'
172 CALL PRINT_ERROR( msgBuf, myThid )
173 STOP 'ABNORMAL END: S/R EXF_CHECK'
174 ENDIF
175 ENDIF
176 ENDIF
177 IF ( (ustress_interpMethod.GE.1 .AND. ustressfile.NE.' ') .OR.
178 & (vstress_interpMethod.GE.1 .AND. vstressfile.NE.' ') ) THEN
179 IF ( readStressOnCgrid ) THEN
180 WRITE(msgBuf,'(A,A)')
181 & 'S/R EXF_CHECK: readStressOnCgrid=.TRUE. ',
182 & 'and interp wind-stress (=A-grid) are not compatible'
183 CALL PRINT_ERROR( msgBuf, myThid )
184 STOP 'ABNORMAL END: S/R EXF_CHECK'
185 ENDIF
186 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
187 IF ( ustress_interpMethod.EQ.0 .OR. ustressfile.EQ.' ' .OR.
188 & vstress_interpMethod.EQ.0 .OR. vstressfile.EQ.' ' ) THEN
189 C- stop if one expects interp+rotation (Curvilin-G) which will not happen
190 WRITE(msgBuf,'(A)')
191 & 'S/R EXF_CHECK: interp. needs 2 components (wind-stress)'
192 CALL PRINT_ERROR( msgBuf, myThid )
193 STOP 'ABNORMAL END: S/R EXF_CHECK'
194 ENDIF
195 IF ( ustressstartdate .NE. vstressstartdate .OR.
196 & ustressperiod .NE. vstressperiod ) THEN
197 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: ',
198 & 'For CurvilinearGrid/RotatedGrid, the u and v wind stress '
199 CALL PRINT_ERROR( msgBuf, myThid )
200 WRITE(msgBuf,'(A,A,A)') 'S/R EXF_CHECK: ',
201 & 'files have to have the same startdate and period, ',
202 & 'because S/R EXF_SET_UV assumes that.'
203 CALL PRINT_ERROR( msgBuf, myThid )
204 STOP 'ABNORMAL END: S/R EXF_CHECK'
205 ENDIF
206 ENDIF
207 ENDIF
208
209 IF ( (ustress_interpMethod.EQ.0 .AND. ustressfile.NE.' ') .OR.
210 & (vstress_interpMethod.EQ.0 .AND. vstressfile.NE.' ') ) THEN
211 #else /* ifndef USE_EXF_INTERPOLATION */
212 IF ( ustressfile .NE. ' ' .OR. vstressfile .NE. ' ' ) THEN
213 #endif /* USE_EXF_INTERPOLATION */
214 IF ( (readStressOnAgrid.AND.readStressOnCgrid) .OR.
215 & .NOT.(readStressOnAgrid.OR.readStressOnCgrid) ) THEN
216 WRITE(msgBuf,'(A)')
217 & 'S/R EXF_CHECK: Select 1 wind-stress position: A or C-grid'
218 CALL PRINT_ERROR( msgBuf, myThid )
219 STOP 'ABNORMAL END: S/R EXF_CHECK'
220 ENDIF
221 ELSE
222 IF ( readStressOnAgrid .OR. readStressOnCgrid ) THEN
223 WRITE(msgBuf,'(A)')
224 & 'S/R EXF_CHECK: wind-stress position irrelevant'
225 CALL PRINT_ERROR( msgBuf, myThid )
226 STOP 'ABNORMAL END: S/R EXF_CHECK'
227 ENDIF
228 ENDIF
229
230 #ifdef USE_NO_INTERP_RUNOFF
231 WRITE(msgBuf,'(A)')
232 & 'S/R EXF_CHECK: USE_NO_INTERP_RUNOFF code has been removed;'
233 CALL PRINT_ERROR( msgBuf, myThid )
234 WRITE(msgBuf,'(A,A)')
235 & 'S/R EXF_CHECK: use instead "runoff_interpMethod=0"',
236 & ' in "data.exf" (EXF_NML_04)'
237 CALL PRINT_ERROR( msgBuf, myThid )
238 STOP 'ABNORMAL END: S/R EXF_CHECK'
239 #endif /* USE_NO_INTERP_RUNOFF */
240
241 #ifdef ALLOW_CLIMTEMP_RELAXATION
242 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: ',
243 & 'ALLOW_CLIMTEMP_RELAXATION no longer supported. Use pkg/rbcs'
244 CALL PRINT_ERROR( msgBuf, myThid )
245 STOP 'ABNORMAL END: S/R EXF_CHECK'
246 #endif
247
248 #ifdef ALLOW_CLIMSALT_RELAXATION
249 WRITE(msgBuf,'(A,A)') 'S/R EXF_CHECK: ',
250 & 'ALLOW_CLIMSALT_RELAXATION no longer supported. Use pkg/rbcs'
251 CALL PRINT_ERROR( msgBuf, myThid )
252 STOP 'ABNORMAL END: S/R EXF_CHECK'
253 #endif
254
255 IF ( climsstTauRelax.NE.0. ) THEN
256 #ifndef ALLOW_CLIMSST_RELAXATION
257 WRITE(msgBuf,'(A)') 'S/R EXF_CHECK: climsstTauRelax > 0'
258 CALL PRINT_ERROR( msgBuf, myThid )
259 WRITE(msgBuf,'(A)')
260 & 'S/R EXF_CHECK: but ALLOW_CLIMSST_RELAXATION is not defined'
261 CALL PRINT_ERROR( msgBuf, myThid )
262 STOP 'ABNORMAL END: S/R EXF_CHECK'
263 #endif
264 IF ( climsstfile.EQ.' ' ) THEN
265 WRITE(msgBuf,'(A)') 'S/R EXF_CHECK: climsstTauRelax > 0 but'
266 CALL PRINT_ERROR( msgBuf, myThid )
267 WRITE(msgBuf,'(A)') 'S/R EXF_CHECK: climsstfile is not set'
268 CALL PRINT_ERROR( msgBuf, myThid )
269 STOP 'ABNORMAL END: S/R EXF_CHECK'
270 ENDIf
271 ENDIf
272
273 IF ( climsssTauRelax.NE.0. ) THEN
274 #ifndef ALLOW_CLIMSSS_RELAXATION
275 WRITE(msgBuf,'(A)') 'S/R EXF_CHECK: climsssTauRelax > 0'
276 CALL PRINT_ERROR( msgBuf, myThid )
277 WRITE(msgBuf,'(A)')
278 & 'S/R EXF_CHECK: but ALLOW_CLIMSSS_RELAXATION is not defined'
279 CALL PRINT_ERROR( msgBuf, myThid )
280 STOP 'ABNORMAL END: S/R EXF_CHECK'
281 #endif
282 IF ( climsssfile.EQ.' ' ) THEN
283 WRITE(msgBuf,'(A)') 'S/R EXF_CHECK: climsssTauRelax > 0 but'
284 CALL PRINT_ERROR( msgBuf, myThid )
285 WRITE(msgBuf,'(A)') 'S/R EXF_CHECK: climsssfile is not set'
286 CALL PRINT_ERROR( msgBuf, myThid )
287 STOP 'ABNORMAL END: S/R EXF_CHECK'
288 ENDIF
289 ENDIF
290
291 RETURN
292 END

  ViewVC Help
Powered by ViewVC 1.1.22