ROMS
Loading...
Searching...
No Matches
checkadj.F File Reference
#include "cppdefs.h"
Include dependency graph for checkadj.F:

Go to the source code of this file.

Functions/Subroutines

subroutine checkadj
 

Function/Subroutine Documentation

◆ checkadj()

subroutine checkadj

Definition at line 2 of file checkadj.F.

3!
4!git $Id$
5!================================================== Hernan G. Arango ===
6! Copyright (c) 2002-2025 The ROMS Group !
7! Licensed under a MIT/X style license !
8! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine checks activated C-preprocessing options for !
12! consistency with all available algorithms. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_parallel
18 USE mod_iounits
19 USE mod_ncparam
20 USE mod_scalars
21 USE mod_strings
22!
23 USE strings_mod, ONLY : uppercase
24!
25 implicit none
26!
27! Local variable declarations.
28!
29 integer :: ic = 0
30 integer :: ifound
31
32 character (len=40) :: string
33!
34!-----------------------------------------------------------------------
35! Report issues with various C-preprocessing options.
36!-----------------------------------------------------------------------
37!
38#ifdef BIO_FASHAM
39 ic=ic+1
40 string=uppercase('bio_fasham')
41 IF (master) WRITE(stdout,10) trim(string), &
42 & 'CPP option renamed to '//uppercase('bio_fennel')
43#endif
44
45 string=uppercase('ts_smagorinsky')
46 ifound=index(trim(coptions), trim(string))
47 IF (ifound.ne.0) THEN
48 IF (master) WRITE(stdout,10) trim(string), &
49 & 'stability problems, WARNING'
50 END IF
51
52 string=uppercase('split_u3')
53 ifound=index(trim(coptions), trim(string))
54 IF (ifound.ne.0) THEN
55 IF (master) WRITE(stdout,10) trim(string), &
56 & 'stability problems, WARNING'
57 END IF
58
59 string=uppercase('uv_smagorinsky')
60 ifound=index(trim(coptions), trim(string))
61 IF (ifound.ne.0) THEN
62 IF (master) WRITE(stdout,10) trim(string), &
63 & 'stability problems, WARNING'
64 END IF
65
66 string=uppercase('uv_u3adv_split')
67 ifound=index(trim(coptions), trim(string))
68 IF (ifound.ne.0) THEN
69 IF (master) WRITE(stdout,10) trim(string), &
70 & 'stability problems, WARNING'
71 END IF
72
73#ifdef IS4DVAR
74 string=uppercase('is4dvar')
75 IF (master) WRITE(stdout,10) trim(string), &
76 & 'deprecated option, use ' // &
77 & uppercase('i4dvar') // &
78 & ' instead, WARNING'
79#endif
80
81#ifdef IS4DVAR_SENSITIVITY
82 string=uppercase('is4dvar_sensitivity')
83 IF (master) WRITE(stdout,10) trim(string), &
84 & 'deprecated option, use ' // &
85 & uppercase('i4dvar_ana_sensitivity') // &
86 & ' instead, WARNING'
87#endif
88
89#ifdef W4DPSAS
90 string=uppercase('w4dpsas')
91 IF (master) WRITE(stdout,10) trim(string), &
92 & 'deprecated option, use ' // &
93 & uppercase('rbl4dvar') // &
94 & ' instead, WARNING'
95#endif
96
97#ifdef W4DPSAS_SENSITIVITY
98 string=uppercase('w4dpsas_sensitivity')
99 IF (master) WRITE(stdout,10) trim(string), &
100 & 'deprecated option, use ' // &
101 & uppercase('rbl4dvar_ana_sensitivity') // &
102 & ' instead, WARNING'
103#endif
104
105#ifdef W4DPSAS_FCT_SENSITIVITY
106 string=uppercase('w4dpsas_fct_sensitivity')
107 IF (master) WRITE(stdout,10) trim(string), &
108 & 'deprecated option, use ' // &
109 & uppercase('rbl4dvar_fct_sensitivity') // &
110 & ' instead, WARNING'
111#endif
112
113#ifdef W4DVAR
114 string=uppercase('w4dvar')
115 IF (master) WRITE(stdout,10) trim(string), &
116 & 'deprecated option, use ' // &
117 & uppercase('r4dvar') // &
118 & ' instead, WARNING'
119#endif
120
121#ifdef W4DVAR_SENSITIVITY
122 string=uppercase('w4dvar_sensitivity')
123 IF (master) WRITE(stdout,10) trim(string), &
124 & 'deprecated option, use ' // &
125 & uppercase('r4dvar_ana_sensitivity') // &
126 & ' instead, WARNING'
127#endif
128
129# ifdef NL_BULK_FLUXES
130 string=uppercase('nl_bulk_fluxes')
131 ic=ic+1
132 IF (master) WRITE(stdout,20) trim(string), &
133 & 'deprecated option, use ' // &
134 & uppercase('forward_fluxes')//' and ' // &
135 & uppercase('prior_bulk_fluxes') // &
136 & ' instead, FATAL ERROR'
137# endif
138
139#if defined TANGENT || defined TL_IOMS || defined ADJOINT
140!
141!-----------------------------------------------------------------------
142! Stop if unsupported C-preprocessing options are activated for the
143! adjoint-based algorithms.
144!-----------------------------------------------------------------------
145!
146 string=uppercase('bedload_mpm')
147 ifound=index(trim(coptions), trim(string))
148 IF (ifound.ne.0) THEN
149 ic=ic+1
150 IF (master) WRITE(stdout,20) trim(string), &
151 & 'not coded, FATAL ERROR'
152 END IF
153!
154 string=uppercase('bedload_soulsby')
155 ifound=index(trim(coptions), trim(string))
156 IF (ifound.ne.0) THEN
157 ic=ic+1
158 IF (master) WRITE(stdout,20) trim(string), &
159 & 'not coded, FATAL ERROR'
160 END IF
161!
162 string=uppercase('bio_fennel')
163 ifound=index(trim(coptions), trim(string))
164 IF (ifound.ne.0) THEN
165 ic=ic+1
166 IF (master) WRITE(stdout,20) trim(string), &
167 & 'not coded, FATAL ERROR'
168 END IF
169
170# ifndef FORWARD_MIXING
171!
172 string=uppercase('bvf_mixing')
173 ifound=index(trim(coptions), trim(string))
174 IF (ifound.ne.0) THEN
175 ic=ic+1
176 IF (master) WRITE(stdout,20) trim(string), &
177 & 'not coded, FATAL ERROR'
178 END IF
179# endif
180!
181 string=uppercase('clima_ts_mix')
182 ifound=index(trim(coptions), trim(string))
183 IF (ifound.ne.0) THEN
184 IF (master) WRITE(stdout,10) trim(string), &
185 & 'not tested, WARNING'
186 END IF
187!
188 IF (any(ad_lbc(ieast,isfsur,:)%radiation)) THEN
189 ic=ic+1
190 IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isFsur)', &
191 & 'not finished, FATAL ERROR'
192 END IF
193!
194 IF (any(ad_lbc(iwest,isfsur,:)%radiation)) THEN
195 ic=ic+1
196 IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isFsur)', &
197 & 'not finished, FATAL ERROR'
198 END IF
199!
200 IF (any(ad_lbc(isouth,isfsur,:)%radiation)) THEN
201 ic=ic+1
202 IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isFsur)', &
203 & 'not finished, FATAL ERROR'
204 END IF
205!
206 IF (any(ad_lbc(inorth,isfsur,:)%radiation)) THEN
207 ic=ic+1
208 IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isFsur)', &
209 & 'not finished, FATAL ERROR'
210 END IF
211!
212 IF (any(ad_lbc(ieast,isubar,:)%radiation)) THEN
213 ic=ic+1
214 IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isUbar)', &
215 & 'not finished, FATAL ERROR'
216 END IF
217!
218 IF (any(ad_lbc(iwest,isubar,:)%radiation)) THEN
219 ic=ic+1
220 IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isUbar)', &
221 & 'not finished, FATAL ERROR'
222 END IF
223!
224 IF (any(ad_lbc(isouth,isubar,:)%radiation)) THEN
225 ic=ic+1
226 IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isUbar)', &
227 & 'not finished, FATAL ERROR'
228 END IF
229!
230 IF (any(ad_lbc(inorth,isubar,:)%radiation)) THEN
231 ic=ic+1
232 IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isUbar)', &
233 & 'not finished, FATAL ERROR'
234 END IF
235!
236 IF (any(ad_lbc(ieast,isvbar,:)%radiation)) THEN
237 ic=ic+1
238 IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isVbar)', &
239 & 'not finished, FATAL ERROR'
240 END IF
241!
242 IF (any(ad_lbc(iwest,isvbar,:)%radiation)) THEN
243 ic=ic+1
244 IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isVbar)', &
245 & 'not finished, FATAL ERROR'
246 END IF
247!
248 IF (any(ad_lbc(isouth,isvbar,:)%radiation)) THEN
249 ic=ic+1
250 IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isVbar)', &
251 & 'not finished, FATAL ERROR'
252 END IF
253!
254 IF (any(ad_lbc(inorth,isvbar,:)%radiation)) THEN
255 ic=ic+1
256 IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isVbar)', &
257 & 'not finished, FATAL ERROR'
258 END IF
259
260# ifdef SOLVE3D
261!
262 IF (any(ad_lbc(ieast,isuvel,:)%radiation)) THEN
263 ic=ic+1
264 IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isUvel)', &
265 & 'not finished, FATAL ERROR'
266 END IF
267!
268 IF (any(ad_lbc(iwest,isuvel,:)%radiation)) THEN
269 ic=ic+1
270 IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isUvel)', &
271 & 'not finished, FATAL ERROR'
272 END IF
273!
274 IF (any(ad_lbc(isouth,isuvel,:)%radiation)) THEN
275 ic=ic+1
276 IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isUvel)', &
277 & 'not finished, FATAL ERROR'
278 END IF
279!
280 IF (any(ad_lbc(inorth,isuvel,:)%radiation)) THEN
281 ic=ic+1
282 IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isUvel)', &
283 & 'not finished, FATAL ERROR'
284 END IF
285!
286 IF (any(ad_lbc(ieast,isvvel,:)%radiation)) THEN
287 ic=ic+1
288 IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isVvel)', &
289 & 'not finished, FATAL ERROR'
290 END IF
291!
292 IF (any(ad_lbc(iwest,isvvel,:)%radiation)) THEN
293 ic=ic+1
294 IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isVvel)', &
295 & 'not finished, FATAL ERROR'
296 END IF
297!
298 IF (any(ad_lbc(isouth,isvvel,:)%radiation)) THEN
299 ic=ic+1
300 IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isVvel)', &
301 & 'not finished, FATAL ERROR'
302 END IF
303!
304 IF (any(ad_lbc(inorth,isvvel,:)%radiation)) THEN
305 ic=ic+1
306 IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isVvel)', &
307 & 'not finished, FATAL ERROR'
308 END IF
309!
310 IF (any(ad_lbc(ieast,istvar(:),:)%radiation)) THEN
311 ic=ic+1
312 IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isTvar(:))', &
313 & 'not finished, FATAL ERROR'
314 END IF
315!
316 IF (any(ad_lbc(iwest,istvar(:),:)%radiation)) THEN
317 ic=ic+1
318 IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isTvar(:))', &
319 & 'not finished, FATAL ERROR'
320 END IF
321!
322 IF (any(ad_lbc(isouth,istvar(:),:)%radiation)) THEN
323 ic=ic+1
324 IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isTvar(:))', &
325 & 'not finished, FATAL ERROR'
326 END IF
327!
328 IF (any(ad_lbc(inorth,istvar(:),:)%radiation)) THEN
329 ic=ic+1
330 IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isTvar(:))', &
331 & 'not finished, FATAL ERROR'
332 END IF
333# endif
334!
335 string=uppercase('ecosim')
336 ifound=index(trim(coptions), trim(string))
337 IF (ifound.ne.0) THEN
338 ic=ic+1
339 IF (master) WRITE(stdout,20) trim(string), &
340 & 'not coded, FATAL ERROR'
341 END IF
342!
343 string=uppercase('geopotential_hconv')
344 ifound=index(trim(coptions), trim(string))
345 IF (ifound.ne.0) THEN
346 ic=ic+1
347 IF (master) WRITE(stdout,10) trim(string), &
348 & 'experimental, AVOID USAGE'
349 END IF
350
351# ifndef FORWARD_MIXING
352!
353 string=uppercase('gls_mixing')
354 ifound=index(trim(coptions), trim(string))
355 IF (ifound.ne.0) THEN
356!! ic=ic+1
357 IF (master) WRITE(stdout,20) trim(string), &
358 & 'not differentiable, WARNING'
359 END IF
360# endif
361!
362 string=uppercase('hypoxia_srm')
363 ifound=index(trim(coptions), trim(string))
364 IF (ifound.ne.0) THEN
365 ic=ic+1
366 IF (master) WRITE(stdout,20) trim(string), &
367 & 'not coded, FATAL ERROR'
368 END IF
369!
370 string=uppercase('limit_bstress')
371 ifound=index(trim(coptions), trim(string))
372 IF (ifound.ne.0) THEN
373 ic=ic+1
374 IF (master) WRITE(stdout,20) trim(string), &
375 & 'not coded, FATAL ERROR'
376 END IF
377
378# ifndef FORWARD_MIXING
379!
380 string=uppercase('lmd_mixing')
381 ifound=index(trim(coptions), trim(string))
382 IF (ifound.ne.0) THEN
383!! ic=ic+1
384 IF (master) WRITE(stdout,20) trim(string), &
385 & 'not differentiable, WARNING'
386 END IF
387# endif
388!
389 string=uppercase('mb_bbl')
390 ifound=index(trim(coptions), trim(string))
391 IF (ifound.ne.0) THEN
392 ic=ic+1
393 IF (master) WRITE(stdout,20) trim(string), &
394 & 'not coded, FATAL ERROR'
395 END IF
396
397# ifndef FORWARD_MIXING
398!
399 string=uppercase('my25_mixing')
400 ifound=index(trim(coptions), trim(string))
401 IF (ifound.ne.0) THEN
402!! ic=ic+1
403 IF (master) WRITE(stdout,20) trim(string), &
404 & 'not differentiable, WARNING'
405 END IF
406# endif
407!
408 string=uppercase('wec')
409 ifound=index(trim(coptions), trim(string))
410 IF (ifound.ne.0) THEN
411 ic=ic+1
412 IF (master) WRITE(stdout,20) trim(string), &
413 & 'not coded, FATAL ERROR'
414 END IF
415!
416 string=uppercase('nemuro')
417 ifound=index(trim(coptions), trim(string))
418 IF (ifound.ne.0) THEN
419 ic=ic+1
420 IF (master) WRITE(stdout,20) trim(string), &
421 & 'not coded, FATAL ERROR'
422 END IF
423!
424 string=uppercase('nesting')
425 ifound=index(trim(coptions), trim(string))
426 IF (ifound.ne.0) THEN
427 ic=ic+1
428 IF (master) WRITE(stdout,20) trim(string), &
429 & 'not coded, FATAL ERROR'
430 END IF
431!
432 string=uppercase('npzd_franks')
433 ifound=index(trim(coptions), trim(string))
434 IF (ifound.ne.0) THEN
435!! ic=ic+1
436 IF (master) WRITE(stdout,20) trim(string), &
437 & 'not working, FATAL ERROR'
438 END IF
439!
440 string=uppercase('pj_gradpq2')
441 ifound=index(trim(coptions), trim(string))
442 IF (ifound.ne.0) THEN
443 ic=ic+1
444 IF (master) WRITE(stdout,20) trim(string), &
445 & 'not coded, FATAL ERROR'
446 END IF
447!
448 string=uppercase('pj_gradpq4')
449 ifound=index(trim(coptions), trim(string))
450 IF (ifound.ne.0) THEN
451 ic=ic+1
452 IF (master) WRITE(stdout,20) trim(string), &
453 & 'not coded, FATAL ERROR'
454 END IF
455!
456 string=uppercase('red_tide')
457 ifound=index(trim(coptions), trim(string))
458 IF (ifound.ne.0) THEN
459 ic=ic+1
460 IF (master) WRITE(stdout,20) trim(string), &
461 & 'not coded, FATAL ERROR'
462 END IF
463!
464 string=uppercase('refdif_coupling')
465 ifound=index(trim(coptions), trim(string))
466 IF (ifound.ne.0) THEN
467 ic=ic+1
468 IF (master) WRITE(stdout,20) trim(string), &
469 & 'not allowed, FATAL ERROR'
470 END IF
471!
472 string=uppercase('sediment')
473 ifound=index(trim(coptions), trim(string))
474 IF (ifound.ne.0) THEN
475 ic=ic+1
476 IF (master) WRITE(stdout,20) trim(string), &
477 & 'not coded, FATAL ERROR'
478 END IF
479!
480 string=uppercase('sed_dens')
481 ifound=index(trim(coptions), trim(string))
482 IF (ifound.ne.0) THEN
483 ic=ic+1
484 IF (master) WRITE(stdout,20) trim(string), &
485 & 'not tested, FATAL ERROR'
486 END IF
487!
488 string=uppercase('sed_morph')
489 ifound=index(trim(coptions), trim(string))
490 IF (ifound.ne.0) THEN
491 ic=ic+1
492 IF (master) WRITE(stdout,20) trim(string), &
493 & 'not coded, FATAL ERROR'
494 END IF
495!
496 string=uppercase('sg_bbl')
497 ifound=index(trim(coptions), trim(string))
498 IF (ifound.ne.0) THEN
499 ic=ic+1
500 IF (master) WRITE(stdout,20) trim(string), &
501 & 'not coded, FATAL ERROR'
502 END IF
503!
504 string=uppercase('ssw_bbl')
505 ifound=index(trim(coptions), trim(string))
506 IF (ifound.ne.0) THEN
507 ic=ic+1
508 IF (master) WRITE(stdout,20) trim(string), &
509 & 'not coded, FATAL ERROR'
510 END IF
511!
512 string=uppercase('suspload')
513 ifound=index(trim(coptions), trim(string))
514 IF (ifound.ne.0) THEN
515 ic=ic+1
516 IF (master) WRITE(stdout,20) trim(string), &
517 & 'not coded, FATAL ERROR'
518 END IF
519!
520 string=uppercase('swan_coupling')
521 ifound=index(trim(coptions), trim(string))
522 IF (ifound.ne.0) THEN
523 ic=ic+1
524 IF (master) WRITE(stdout,20) trim(string), &
525 & 'not allowed, FATAL ERROR'
526 END IF
527!
528# if defined TANGENT || defined TL_IOMS
529 IF (any(tl_hadvection(:,:)%MPDATA).or. &
530 & any(tl_vadvection(:,:)%MPDATA)) THEN
531 string=uppercase('mpdata')
532 ifound=index(trim(coptions), trim(string))
533 IF (ifound.ne.0) THEN
534 ic=ic+1
535 IF (master) WRITE(stdout,20) trim(string), &
536 & 'not coded, FATAL ERROR'
537 END IF
538 END IF
539!
540 IF (any(tl_hadvection(:,:)%HSIMT).or. &
541 & any(tl_vadvection(:,:)%HSIMT)) THEN
542 string=uppercase('hsimt')
543 ifound=index(trim(coptions), trim(string))
544 IF (ifound.ne.0) THEN
545 ic=ic+1
546 IF (master) WRITE(stdout,20) trim(string), &
547 & 'not coded, FATAL ERROR'
548 END IF
549 END IF
550!
551 IF (any(tl_hadvection(:,:)%SPLIT_U3).or. &
552 & any(tl_vadvection(:,:)%SPLIT_U3)) THEN
553 string=uppercase('split_u3')
554 ifound=index(trim(coptions), trim(string))
555 IF (ifound.ne.0) THEN
556 ic=ic+1
557 IF (master) WRITE(stdout,20) trim(string), &
558 & 'not coded, FATAL ERROR'
559 END IF
560 END IF
561# endif
562!
563 string=uppercase('ts_smagorinsky')
564 ifound=index(trim(coptions), trim(string))
565 IF (ifound.ne.0) THEN
566 ic=ic+1
567 IF (master) WRITE(stdout,20) trim(string), &
568 & 'not coded, FATAL ERROR'
569 END IF
570!
571 string=uppercase('uv_smagorinsky')
572 ifound=index(trim(coptions), trim(string))
573 IF (ifound.ne.0) THEN
574 ic=ic+1
575 IF (master) WRITE(stdout,20) trim(string), &
576 & 'not coded, FATAL ERROR'
577 END IF
578!
579 string=uppercase('uv_u3adv_split')
580 ifound=index(trim(coptions), trim(string))
581 IF (ifound.ne.0) THEN
582 ic=ic+1
583 IF (master) WRITE(stdout,20) trim(string), &
584 & 'not coded, FATAL ERROR'
585 END IF
586!
587 string=uppercase('wet_dry')
588 ifound=index(trim(coptions), trim(string))
589 IF (ifound.ne.0) THEN
590 ic=ic+1
591 IF (master) WRITE(stdout,20) trim(string), &
592 & 'not coded, FATAL ERROR'
593 END IF
594#endif
595!
596!-----------------------------------------------------------------------
597! Set execution error flag to stop execution.
598!-----------------------------------------------------------------------
599!
600 IF (ic.gt.0) THEN
601 exit_flag=5
602 END IF
603!
604 10 FORMAT (/,' CHECKADJ - use caution when activating: ', a,/,12x, &
605 & 'REASON: ',a,'.')
606#if defined TANGENT || defined TL_IOMS || defined ADJOINT
607 20 FORMAT (/,' CHECKADJ - unsupported option in adjoint-based', &
608 & ' algorithms: ',a,/,12x,'REASON: ',a,'.')
609#endif
610!
611 RETURN
integer stdout
integer isvvel
integer isvbar
integer, dimension(:), allocatable istvar
integer isuvel
integer isfsur
integer isubar
logical master
type(t_lbc), dimension(:,:,:), allocatable ad_lbc
Definition mod_param.F:378
type(t_adv), dimension(:,:), allocatable tl_hadvection
Definition mod_param.F:411
type(t_adv), dimension(:,:), allocatable tl_vadvection
Definition mod_param.F:412
integer, parameter iwest
integer exit_flag
integer, parameter isouth
integer, parameter ieast
integer, parameter inorth
character(len=2048) coptions
character(len(sinp)) function, public uppercase(sinp)
Definition strings.F:582

References mod_param::ad_lbc, mod_strings::coptions, mod_scalars::exit_flag, mod_scalars::ieast, mod_scalars::inorth, mod_ncparam::isfsur, mod_scalars::isouth, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::iwest, mod_parallel::master, mod_iounits::stdout, mod_param::tl_hadvection, mod_param::tl_vadvection, and strings_mod::uppercase().

Referenced by checkdefs().

Here is the call graph for this function:
Here is the caller graph for this function: