FMS  2025.04
Flexible Modeling System
fm_util.F90
1 !***********************************************************************
2 !* Apache License 2.0
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* Licensed under the Apache License, Version 2.0 (the "License");
7 !* you may not use this file except in compliance with the License.
8 !* You may obtain a copy of the License at
9 !*
10 !* http://www.apache.org/licenses/LICENSE-2.0
11 !*
12 !* FMS is distributed in the hope that it will be useful, but WITHOUT
13 !* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
14 !* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
15 !* PARTICULAR PURPOSE. See the License for the specific language
16 !* governing permissions and limitations under the License.
17 !***********************************************************************
18 !> @defgroup fm_util_mod fm_util_mod
19 !> @ingroup field_manager
20 !> @brief This module provides utility routines for the field manager.
21 !!
22 !> Routines for error catching, reporting and
23 !! termination while interfacing with the field manager.
24 !> @author Richard D. Slater
25 
26 !> @addtogroup fm_util_mod
27 !> @{
28 module fm_util_mod !{
29 
30 use field_manager_mod, only: fm_string_len, fm_field_name_len, fm_type_name_len
31 use field_manager_mod, only: fm_get_type, fm_get_index, fm_get_length
32 use field_manager_mod, only: fm_get_current_list, fm_new_list, fm_change_list, fm_loop_over_list
33 use field_manager_mod, only: fm_new_value, fm_get_value
34 use field_manager_mod, only: fm_exists, fm_dump_list
35 use fms_mod, only: fatal, stdout
36 use mpp_mod, only: mpp_error
37 use platform_mod, only: r4_kind, r8_kind, fms_path_len
38 
39 implicit none
40 
41 private
42 
43 public fm_util_start_namelist
44 public fm_util_end_namelist
45 public fm_util_check_for_bad_fields
46 public fm_util_set_caller
47 public fm_util_reset_caller
48 public fm_util_set_no_overwrite
49 public fm_util_reset_no_overwrite
50 public fm_util_set_good_name_list
51 public fm_util_reset_good_name_list
52 public fm_util_get_length
53 public fm_util_get_integer
54 public fm_util_get_logical
55 public fm_util_get_real
56 public fm_util_get_string
57 public fm_util_get_integer_array
58 public fm_util_get_logical_array
59 public fm_util_get_real_array
60 public fm_util_get_string_array
61 public fm_util_set_value
62 !public fm_util_get_index
63 public fm_util_get_index_list
64 public fm_util_get_index_string
65 
66 !
67 ! Public variables
68 !
69 
70 character(len=128), public :: fm_util_default_caller = ' '
71 
72 !
73 ! private parameters
74 !
75 
76 character(len=48), parameter :: mod_name = 'fm_util_mod'
77 
78 !
79 ! Private variables
80 !
81 
82 character(len=128) :: save_default_caller = ' '
83 character(len=128) :: default_good_name_list = ' '
84 character(len=128) :: save_default_good_name_list = ' '
85 logical :: default_no_overwrite = .false.
86 logical :: save_default_no_overwrite = .false.
87 character(len=FMS_PATH_LEN) :: save_current_list
88 character(len=FMS_PATH_LEN) :: save_path
89 character(len=FMS_PATH_LEN) :: save_name
90 ! Include variable "version" to be written to log file.
91 #include<file_version.h>
92 
93 !
94 ! Interface definitions for overloaded routines
95 !
96 
97 !> @}
98 
99 interface fm_util_set_value_real
100  module procedure fm_util_set_value_real_r4
101  module procedure fm_util_set_value_real_r8
102 end interface fm_util_set_value_real
103 
104 interface fm_util_set_value_real_array
105  module procedure fm_util_set_value_real_array_r4
106  module procedure fm_util_set_value_real_array_r8
107 end interface fm_util_set_value_real_array
108 
109 !> @ingroup fm_util_mod
110 interface fm_util_set_value !{
111  module procedure fm_util_set_value_integer_array
112  module procedure fm_util_set_value_real_array_r4
113  module procedure fm_util_set_value_real_array_r8
114  module procedure fm_util_set_value_logical_array
115  module procedure fm_util_set_value_string_array
116  module procedure fm_util_set_value_real_r4
117  module procedure fm_util_set_value_real_r8
118  module procedure fm_util_set_value_integer
119  module procedure fm_util_set_value_logical
120  module procedure fm_util_set_value_string
121 end interface !}
122 
123 !interface fm_util_get_index !{
124  !module procedure fm_util_get_index_list
125  !module procedure fm_util_get_index_string
126 !end interface !}
127 
128 !> @addtogroup fm_util_mod
129 !> @{
130 
131 contains
132 
133 !> Set the default value for the optional "caller" variable used in many of these
134 !! subroutines. If the argument is blank, then set the default to blank, otherwise
135 !! the deault will have brackets placed around the argument.
136 subroutine fm_util_set_caller(caller) !{
137 
138 implicit none
139 
140 !
141 ! arguments
142 !
143 
144 character(len=*), intent(in) :: caller
145 
146 !
147 ! Local variables
148 !
149 
150 !
151 ! save the default caller string
152 !
153 
154 save_default_caller = fm_util_default_caller
155 
156 !
157 ! set the default caller string
158 !
159 
160 if (caller .eq. ' ') then !{
161  fm_util_default_caller = ' '
162 else !}{
163  fm_util_default_caller = '[' // trim(caller) // ']'
164 endif !}
165 
166 return
167 
168 end subroutine fm_util_set_caller !}
169 
170 !#######################################################################
171 
172 !> Reset the default value for the optional "caller" variable used in many of these
173 !! subroutines to blank.
174 subroutine fm_util_reset_caller !{
175 
176 implicit none
177 
178 !
179 ! arguments
180 !
181 
182 !
183 ! Local variables
184 !
185 
186 !
187 ! reset the default caller string
188 !
189 
190 fm_util_default_caller = save_default_caller
191 save_default_caller = ' '
192 
193 return
194 
195 end subroutine fm_util_reset_caller !}
196 
197 !#######################################################################
198 
199 !> Set the default value for the optional "good_name_list" variable used in many of these
200 !! subroutines.
201 subroutine fm_util_set_good_name_list(good_name_list) !{
202 
203 implicit none
204 
205 !
206 ! arguments
207 !
208 
209 character(len=*), intent(in) :: good_name_list
210 
211 !
212 ! Local variables
213 !
214 
215 !
216 ! save the default good_name_list string
217 !
218 
219 save_default_good_name_list = default_good_name_list
220 
221 !
222 ! set the default good_name_list string
223 !
224 
225 default_good_name_list = good_name_list
226 
227 return
228 
229 end subroutine fm_util_set_good_name_list !}
230 
231 !#######################################################################
232 
233 !> Reset the default value for the optional "good_name_list" variable used in many of these
234 !! subroutines to the saved value.
235 subroutine fm_util_reset_good_name_list !{
236 
237 implicit none
238 
239 !
240 ! arguments
241 !
242 
243 !
244 ! Local variables
245 !
246 
247 !
248 ! reset the default good_name_list string
249 !
250 
251 default_good_name_list = save_default_good_name_list
252 save_default_good_name_list = ' '
253 
254 return
255 
256 end subroutine fm_util_reset_good_name_list !}
257 
258 !#######################################################################
259 
260 !> Set the default value for the optional "no_overwrite" variable used in some of these
261 !! subroutines.
262 subroutine fm_util_set_no_overwrite(no_overwrite) !{
263 
264 implicit none
265 
266 !
267 ! arguments
268 !
269 
270 logical, intent(in) :: no_overwrite
271 
272 !
273 ! Local variables
274 !
275 
276 !
277 ! save the default no_overwrite string
278 !
279 
280 save_default_no_overwrite = default_no_overwrite
281 
282 !
283 ! set the default no_overwrite value
284 !
285 
286 default_no_overwrite = no_overwrite
287 
288 return
289 
290 end subroutine fm_util_set_no_overwrite !}
291 
292 !#######################################################################
293 
294 !> Reset the default value for the optional "no_overwrite" variable used in some of these
295 !! subroutines to false.
296 subroutine fm_util_reset_no_overwrite !{
297 
298 implicit none
299 
300 !
301 ! arguments
302 !
303 
304 !
305 ! Local variables
306 !
307 
308 !
309 ! reset the default no_overwrite value
310 !
311 
312 default_no_overwrite = save_default_no_overwrite
313 save_default_no_overwrite = .false.
314 
315 return
316 
317 end subroutine fm_util_reset_no_overwrite !}
318 
319 !#######################################################################
320 
321 !> Check for unrecognized fields in a list
322 subroutine fm_util_check_for_bad_fields(list, good_fields, caller) !{
323 
324 implicit none
325 
326 !
327 ! arguments
328 !
329 
330 character(len=*), intent(in) :: list
331 character(len=*), intent(in), dimension(:) :: good_fields
332 character(len=*), intent(in), optional :: caller
333 
334 !
335 ! Local parameters
336 !
337 
338 character(len=48), parameter :: sub_name = 'fm_util_check_for_bad_fields'
339 
340 !
341 ! Local variables
342 !
343 
344 logical :: fm_success
345 integer :: i
346 integer :: ind
347 integer :: list_length
348 integer :: good_length
349 character(len=fm_type_name_len) :: typ
350 character(len=fm_field_name_len) :: name
351 logical :: found
352 character(len=256) :: error_header
353 character(len=256) :: warn_header
354 character(len=256) :: note_header
355 character(len=128) :: caller_str
356 integer :: out_unit
357 
358 out_unit = stdout()
359 
360 !
361 ! set the caller string and headers
362 !
363 
364 if (present(caller)) then !{
365  caller_str = '[' // trim(caller) // ']'
366 else !}{
367  caller_str = fm_util_default_caller
368 endif !}
369 
370 error_header = '==>Error from ' // trim(mod_name) // &
371  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
372 warn_header = '==>Warning from ' // trim(mod_name) // &
373  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
374 note_header = '==>Note from ' // trim(mod_name) // &
375  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
376 
377 !
378 ! check that a list is given (fatal if not)
379 !
380 
381 if (list .eq. ' ') then !{
382  write (out_unit,*) trim(error_header) // ' Empty list given'
383  call mpp_error(fatal, trim(error_header) // ' Empty list given')
384 endif !}
385 
386 !
387 ! Check that we have been given a list
388 !
389 
390 if (fm_get_type(list) .ne. 'list') then !{
391  write (out_unit,*) trim(error_header) // ' Not given a list: ' // trim(list)
392  call mpp_error(fatal, trim(error_header) // ' Not given a list: ' // trim(list))
393 endif !}
394 
395 !
396 ! Get the list length
397 !
398 
399 list_length = fm_get_length(list)
400 if (list_length .lt. 0) then !{
401  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(list))
402 endif !}
403 
404 !
405 ! Get the number of good fields
406 !
407 
408 good_length = size(good_fields)
409 
410 if (list_length .lt. good_length) then !{
411 
412 !
413 ! If the list length is less than the number of good fields this is an error
414 ! as the list should be fully populated and we'll check which extra fields
415 ! are given in good_fields
416 !
417 
418  write (out_unit,*) trim(error_header), ' List length < number of good fields (', &
419  list_length, ' < ', good_length, ') in list ', trim(list)
420 
421  write (out_unit,*)
422  write (out_unit,*) 'The list contains the following fields:'
423  fm_success= fm_dump_list(list, .false.)
424  write (out_unit,*)
425  write (out_unit,*) 'The supposed list of good fields is:'
426  do i = 1, good_length !{
427  if (fm_exists(trim(list) // '/' // good_fields(i))) then !{
428  write (out_unit,*) 'List field: "', trim(good_fields(i)), '"'
429  else !}{
430  write (out_unit,*) 'EXTRA good field: "', trim(good_fields(i)), '"'
431  endif !}
432  enddo !} i
433  write (out_unit,*)
434 
435  call mpp_error(fatal, trim(error_header) // &
436  ' List length < number of good fields for list: ' // trim(list))
437 
438 elseif (list_length .gt. good_length) then !}{
439 
440 !
441 ! If the list length is greater than the number of good fields this is an error
442 ! as the there should not be any more fields than those given in the good fields list
443 ! and we'll check which extra fields are given in the list
444 !
445 
446  write (out_unit,*) trim(warn_header), 'List length > number of good fields (', &
447  list_length, ' > ', good_length, ') in list ', trim(list)
448 
449  write (out_unit,*) trim(error_header), ' Start of list of fields'
450  do while (fm_loop_over_list(list, name, typ, ind)) !{
451  found = .false.
452  do i = 1, good_length !{
453  found = found .or. (name .eq. good_fields(i))
454  enddo !} i
455  if (found) then !{
456  write (out_unit,*) 'Good list field: "', trim(name), '"'
457  else !}{
458  write (out_unit,*) 'EXTRA list field: "', trim(name), '"'
459  endif !}
460  enddo !}
461  write (out_unit,*) trim(error_header), ' End of list of fields'
462 
463  call mpp_error(fatal, trim(error_header) // &
464  ' List length > number of good fields for list: ' // trim(list))
465 
466 endif !}
467 
468 !
469 ! If the list length equals the number of good fields then all is good
470 !
471 
472 return
473 
474 end subroutine fm_util_check_for_bad_fields !}
475 
476 !#######################################################################
477 
478 !> Get the length of an element of the Field Manager tree
479 function fm_util_get_length(name, caller) &
480  result(field_length) !{
481 
482 implicit none
483 
484 !
485 ! Return type
486 !
487 
488 integer :: field_length
489 
490 !
491 ! arguments
492 !
493 
494 character(len=*), intent(in) :: name
495 character(len=*), intent(in), optional :: caller
496 
497 !
498 ! Local parameters
499 !
500 
501 character(len=48), parameter :: sub_name = 'fm_util_get_length'
502 
503 !
504 ! Local variables
505 !
506 
507 character(len=256) :: error_header
508 character(len=256) :: warn_header
509 character(len=256) :: note_header
510 character(len=128) :: caller_str
511 
512 !
513 ! set the caller string and headers
514 !
515 
516 if (present(caller)) then !{
517  caller_str = '[' // trim(caller) // ']'
518 else !}{
519  caller_str = fm_util_default_caller
520 endif !}
521 
522 error_header = '==>Error from ' // trim(mod_name) // &
523  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
524 warn_header = '==>Warning from ' // trim(mod_name) // &
525  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
526 note_header = '==>Note from ' // trim(mod_name) // &
527  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
528 
529 !
530 ! check that a name is given (fatal if not)
531 !
532 
533 if (name .eq. ' ') then !{
534  call mpp_error(fatal, trim(error_header) // ' Empty name given')
535 endif !}
536 
537 !
538 ! Get the field's length
539 !
540 
541 field_length = fm_get_length(name)
542 if (field_length .lt. 0) then !{
543  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
544 endif !}
545 
546 return
547 
548 end function fm_util_get_length !}
549 
550 !#######################################################################
551 
552 !> Get the index of an element of a string in the Field Manager tree
553 function fm_util_get_index_string(name, string, caller) &
554  result(fm_index) !{
555 
556 implicit none
557 
558 !
559 ! Return type
560 !
561 
562 integer :: fm_index
563 
564 !
565 ! arguments
566 !
567 
568 character(len=*), intent(in) :: name
569 character(len=*), intent(in) :: string
570 character(len=*), intent(in), optional :: caller
571 
572 !
573 ! Local parameters
574 !
575 
576 character(len=48), parameter :: sub_name = 'fm_util_get_index_string'
577 
578 !
579 ! Local variables
580 !
581 
582 character(len=256) :: error_header
583 character(len=256) :: warn_header
584 character(len=256) :: note_header
585 character(len=128) :: caller_str
586 character(len=32) :: index_str
587 character(len=fm_type_name_len) :: fm_type
588 character(len=fm_string_len) :: fm_string
589 integer :: i
590 integer :: length
591 
592 !
593 ! set the caller string and headers
594 !
595 
596 if (present(caller)) then !{
597  caller_str = '[' // trim(caller) // ']'
598 else !}{
599  caller_str = fm_util_default_caller
600 endif !}
601 
602 error_header = '==>Error from ' // trim(mod_name) // &
603  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
604 warn_header = '==>Warning from ' // trim(mod_name) // &
605  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
606 note_header = '==>Note from ' // trim(mod_name) // &
607  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
608 
609 !
610 ! check that a name is given (fatal if not)
611 !
612 
613 if (name .eq. ' ') then !{
614  call mpp_error(fatal, trim(error_header) // ' Empty name given')
615 endif !}
616 
617 !
618 ! Check the field's type and get the index
619 !
620 
621 fm_index = 0
622 fm_type = fm_get_type(name)
623 if (fm_type .eq. 'string') then !{
624  length = fm_get_length(name)
625  if (length .lt. 0) then !{
626  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
627  endif !}
628  if (length .gt. 0) then !{
629  do i = 1, length !{
630  if (.not. fm_get_value(name, fm_string, index = i)) then !{
631  write (index_str,*) '(', i, ')'
632  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name) // trim(index_str))
633  endif !}
634  if (fm_string .eq. string) then !{
635  fm_index = i
636  exit
637  endif !}
638  enddo !} i
639  endif !}
640 elseif (fm_type .eq. ' ') then !}{
641  call mpp_error(fatal, trim(error_header) // ' Array does not exist: ' // trim(name))
642 else !}{
643  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
644 endif !}
645 
646 !if (fm_index .eq. 0) then !{
647  !call mpp_error(FATAL, trim(error_header) // ' "' // trim(string) // '" does not exist in ' // trim(name))
648 !endif !}
649 
650 return
651 
652 end function fm_util_get_index_string !}
653 
654 !#######################################################################
655 
656 !> Get the length of an element of the Field Manager tree
657 function fm_util_get_index_list(name, caller) &
658  result(fm_index) !{
659 
660 implicit none
661 
662 !
663 ! Return type
664 !
665 
666 integer :: fm_index
667 
668 !
669 ! arguments
670 !
671 
672 character(len=*), intent(in) :: name
673 character(len=*), intent(in), optional :: caller
674 
675 !
676 ! Local parameters
677 !
678 
679 character(len=48), parameter :: sub_name = 'fm_util_get_index_list'
680 
681 !
682 ! Local variables
683 !
684 
685 character(len=256) :: error_header
686 character(len=256) :: warn_header
687 character(len=256) :: note_header
688 character(len=128) :: caller_str
689 character(len=fm_type_name_len) :: fm_type
690 
691 !
692 ! set the caller string and headers
693 !
694 
695 if (present(caller)) then !{
696  caller_str = '[' // trim(caller) // ']'
697 else !}{
698  caller_str = fm_util_default_caller
699 endif !}
700 
701 error_header = '==>Error from ' // trim(mod_name) // &
702  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
703 warn_header = '==>Warning from ' // trim(mod_name) // &
704  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
705 note_header = '==>Note from ' // trim(mod_name) // &
706  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
707 
708 !
709 ! check that a name is given (fatal if not)
710 !
711 
712 if (name .eq. ' ') then !{
713  call mpp_error(fatal, trim(error_header) // ' Empty name given')
714 endif !}
715 
716 !
717 ! Check the field's type and get the index
718 !
719 
720 fm_index = 0
721 fm_type = fm_get_type(name)
722 if (fm_type .eq. 'list') then !{
723  fm_index = fm_get_index(name)
724  if (fm_index .le. 0) then !{
725  call mpp_error(fatal, trim(error_header) // ' List does not exist: ' // trim(name))
726  endif !}
727 elseif (fm_type .eq. ' ') then !}{
728  call mpp_error(fatal, trim(error_header) // ' List does not exist: ' // trim(name))
729 else !}{
730  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
731 endif !}
732 
733 
734 return
735 
736 end function fm_util_get_index_list !}
737 
738 
739 !#######################################################################
740 
741 !> Get an integer value from the Field Manager tree.
742 function fm_util_get_integer_array(name, caller) &
743  result(array) !{
744 
745 implicit none
746 
747 !
748 ! Return type
749 !
750 
751 integer, pointer, dimension(:) :: array
752 
753 !
754 ! arguments
755 !
756 
757 character(len=*), intent(in) :: name
758 character(len=*), intent(in), optional :: caller
759 
760 !
761 ! Local parameters
762 !
763 
764 character(len=48), parameter :: sub_name = 'fm_util_get_integer_array'
765 
766 !
767 ! Local variables
768 !
769 
770 character(len=256) :: error_header
771 character(len=256) :: warn_header
772 character(len=256) :: note_header
773 character(len=128) :: caller_str
774 character(len=32) :: index_str
775 character(len=fm_type_name_len) :: fm_type
776 integer :: i
777 integer :: length
778 
779 nullify(array)
780 
781 !
782 ! set the caller string and headers
783 !
784 
785 if (present(caller)) then !{
786  caller_str = '[' // trim(caller) // ']'
787 else !}{
788  caller_str = fm_util_default_caller
789 endif !}
790 
791 error_header = '==>Error from ' // trim(mod_name) // &
792  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
793 warn_header = '==>Warning from ' // trim(mod_name) // &
794  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
795 note_header = '==>Note from ' // trim(mod_name) // &
796  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
797 
798 !
799 ! check that a name is given (fatal if not)
800 !
801 
802 if (name .eq. ' ') then !{
803  call mpp_error(fatal, trim(error_header) // ' Empty name given')
804 endif !}
805 
806 fm_type = fm_get_type(name)
807 if (fm_type .eq. 'integer') then !{
808  length = fm_get_length(name)
809  if (length .lt. 0) then !{
810  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
811  endif !}
812  if (length .gt. 0) then !{
813  allocate(array(length))
814  do i = 1, length !{
815  if (.not. fm_get_value(name, array(i), index = i)) then !{
816  write (index_str,*) '(', i, ')'
817  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name) // trim(index_str))
818  endif !}
819  enddo !} i
820  endif !}
821 elseif (fm_type .eq. ' ') then !}{
822  call mpp_error(fatal, trim(error_header) // ' Array does not exist: ' // trim(name))
823 else !}{
824  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
825 endif !}
826 
827 return
828 
829 end function fm_util_get_integer_array !}
830 
831 !#######################################################################
832 
833 !> Get a logical value from the Field Manager tree.
834 function fm_util_get_logical_array(name, caller) &
835  result(array) !{
836 
837 implicit none
838 
839 !
840 ! Return type
841 !
842 
843 logical, pointer, dimension(:) :: array
844 
845 !
846 ! arguments
847 !
848 
849 character(len=*), intent(in) :: name
850 character(len=*), intent(in), optional :: caller
851 
852 !
853 ! Local parameters
854 !
855 
856 character(len=48), parameter :: sub_name = 'fm_util_get_logical_array'
857 
858 !
859 ! Local variables
860 !
861 
862 character(len=256) :: error_header
863 character(len=256) :: warn_header
864 character(len=256) :: note_header
865 character(len=128) :: caller_str
866 character(len=32) :: index_str
867 character(len=fm_type_name_len) :: fm_type
868 integer :: i
869 integer :: length
870 
871 nullify(array)
872 
873 !
874 ! set the caller string and headers
875 !
876 
877 if (present(caller)) then !{
878  caller_str = '[' // trim(caller) // ']'
879 else !}{
880  caller_str = fm_util_default_caller
881 endif !}
882 
883 error_header = '==>Error from ' // trim(mod_name) // &
884  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
885 warn_header = '==>Warning from ' // trim(mod_name) // &
886  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
887 note_header = '==>Note from ' // trim(mod_name) // &
888  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
889 
890 !
891 ! check that a name is given (fatal if not)
892 !
893 
894 if (name .eq. ' ') then !{
895  call mpp_error(fatal, trim(error_header) // ' Empty name given')
896 endif !}
897 
898 fm_type = fm_get_type(name)
899 if (fm_type .eq. 'logical') then !{
900  length = fm_get_length(name)
901  if (length .lt. 0) then !{
902  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
903  endif !}
904  if (length .gt. 0) then !{
905  allocate(array(length))
906  do i = 1, length !{
907  if (.not. fm_get_value(name, array(i), index = i)) then !{
908  write (index_str,*) '(', i, ')'
909  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name) // trim(index_str))
910  endif !}
911  enddo !} i
912  endif !}
913 elseif (fm_type .eq. ' ') then !}{
914  call mpp_error(fatal, trim(error_header) // ' Array does not exist: ' // trim(name))
915 else !}{
916  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
917 endif !}
918 
919 return
920 
921 end function fm_util_get_logical_array !}
922 
923 !#######################################################################
924 
925 !> Get a real value from the Field Manager tree.
926 function fm_util_get_real_array(name, caller) &
927  result(array) !{
928 
929 implicit none
930 
931 !
932 ! Return type
933 !
934 
935 real(r8_kind), pointer, dimension(:) :: array
936 
937 !
938 ! arguments
939 !
940 
941 character(len=*), intent(in) :: name
942 character(len=*), intent(in), optional :: caller
943 
944 !
945 ! Local parameters
946 !
947 
948 character(len=48), parameter :: sub_name = 'fm_util_get_real_array'
949 
950 !
951 ! Local variables
952 !
953 
954 character(len=256) :: error_header
955 character(len=256) :: warn_header
956 character(len=256) :: note_header
957 character(len=128) :: caller_str
958 character(len=32) :: index_str
959 character(len=fm_type_name_len) :: fm_type
960 integer :: i
961 integer :: length
962 
963 nullify(array)
964 
965 !
966 ! set the caller string and headers
967 !
968 
969 if (present(caller)) then !{
970  caller_str = '[' // trim(caller) // ']'
971 else !}{
972  caller_str = fm_util_default_caller
973 endif !}
974 
975 error_header = '==>Error from ' // trim(mod_name) // &
976  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
977 warn_header = '==>Warning from ' // trim(mod_name) // &
978  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
979 note_header = '==>Note from ' // trim(mod_name) // &
980  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
981 
982 !
983 ! check that a name is given (fatal if not)
984 !
985 
986 if (name .eq. ' ') then !{
987  call mpp_error(fatal, trim(error_header) // ' Empty name given')
988 endif !}
989 
990 fm_type = fm_get_type(name)
991 if (fm_type .eq. 'real') then !{
992  length = fm_get_length(name)
993  if (length .lt. 0) then !{
994  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
995  endif !}
996  if (length .gt. 0) then !{
997  allocate(array(length))
998  do i = 1, length !{
999  if (.not. fm_get_value(name, array(i), index = i)) then !{
1000  write (index_str,*) '(', i, ')'
1001  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name) // trim(index_str))
1002  endif !}
1003  enddo !} i
1004  endif !}
1005 elseif (fm_type .eq. ' ') then !}{
1006  call mpp_error(fatal, trim(error_header) // ' Array does not exist: ' // trim(name))
1007 else !}{
1008  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
1009 endif !}
1010 
1011 return
1012 
1013 end function fm_util_get_real_array !}
1014 
1015 !#######################################################################
1016 
1017 
1018 !> Get a string value from the Field Manager tree.
1019 function fm_util_get_string_array(name, caller) &
1020  result(array) !{
1021 
1022 implicit none
1023 
1024 !
1025 ! Return type
1026 !
1027 
1028 character(len=fm_string_len), pointer, dimension(:) :: array
1029 
1030 !
1031 ! arguments
1032 !
1033 
1034 character(len=*), intent(in) :: name
1035 character(len=*), intent(in), optional :: caller
1036 
1037 !
1038 ! Local parameters
1039 !
1040 
1041 character(len=48), parameter :: sub_name = 'fm_util_get_string_array'
1042 
1043 !
1044 ! Local variables
1045 !
1046 
1047 character(len=256) :: error_header
1048 character(len=256) :: warn_header
1049 character(len=256) :: note_header
1050 character(len=128) :: caller_str
1051 character(len=32) :: index_str
1052 character(len=fm_type_name_len) :: fm_type
1053 integer :: i
1054 integer :: length
1055 
1056 nullify(array)
1057 
1058 !
1059 ! set the caller string and headers
1060 !
1061 
1062 if (present(caller)) then !{
1063  caller_str = '[' // trim(caller) // ']'
1064 else !}{
1065  caller_str = fm_util_default_caller
1066 endif !}
1067 
1068 error_header = '==>Error from ' // trim(mod_name) // &
1069  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1070 warn_header = '==>Warning from ' // trim(mod_name) // &
1071  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1072 note_header = '==>Note from ' // trim(mod_name) // &
1073  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1074 
1075 !
1076 ! check that a name is given (fatal if not)
1077 !
1078 
1079 if (name .eq. ' ') then !{
1080  call mpp_error(fatal, trim(error_header) // ' Empty name given')
1081 endif !}
1082 
1083 fm_type = fm_get_type(name)
1084 if (fm_type .eq. 'string') then !{
1085  length = fm_get_length(name)
1086  if (length .lt. 0) then !{
1087  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
1088  endif !}
1089  if (length .gt. 0) then !{
1090  allocate(array(length))
1091  do i = 1, length !{
1092  if (.not. fm_get_value(name, array(i), index = i)) then !{
1093  write (index_str,*) '(', i, ')'
1094  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name) // trim(index_str))
1095  endif !}
1096  enddo !} i
1097  endif !}
1098 elseif (fm_type .eq. ' ') then !}{
1099  call mpp_error(fatal, trim(error_header) // ' Array does not exist: ' // trim(name))
1100 else !}{
1101  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
1102 endif !}
1103 
1104 return
1105 
1106 end function fm_util_get_string_array !}
1107 
1108 !#######################################################################
1109 
1110 !> Get an integer value from the Field Manager tree.
1111 function fm_util_get_integer(name, caller, index, default_value, scalar) &
1112  result(ival) !{
1113 
1114 implicit none
1115 
1116 !
1117 ! Return type
1118 !
1119 
1120 integer :: ival
1121 
1122 !
1123 ! arguments
1124 !
1125 
1126 character(len=*), intent(in) :: name
1127 character(len=*), intent(in), optional :: caller
1128 integer, intent(in), optional :: index
1129 integer, intent(in), optional :: default_value
1130 logical, intent(in), optional :: scalar
1131 
1132 !
1133 ! Local parameters
1134 !
1135 
1136 character(len=48), parameter :: sub_name = 'fm_util_get_integer'
1137 
1138 !
1139 ! Local variables
1140 !
1141 
1142 character(len=256) :: error_header
1143 character(len=256) :: warn_header
1144 character(len=256) :: note_header
1145 character(len=128) :: caller_str
1146 integer :: index_t
1147 character(len=fm_type_name_len) :: fm_type
1148 integer :: field_length
1149 
1150 !
1151 ! set the caller string and headers
1152 !
1153 
1154 if (present(caller)) then !{
1155  caller_str = '[' // trim(caller) // ']'
1156 else !}{
1157  caller_str = fm_util_default_caller
1158 endif !}
1159 
1160 error_header = '==>Error from ' // trim(mod_name) // &
1161  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1162 warn_header = '==>Warning from ' // trim(mod_name) // &
1163  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1164 note_header = '==>Note from ' // trim(mod_name) // &
1165  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1166 
1167 !
1168 ! check that a name is given (fatal if not)
1169 !
1170 
1171 if (name .eq. ' ') then !{
1172  call mpp_error(fatal, trim(error_header) // ' Empty name given')
1173 endif !}
1174 
1175 !
1176 ! Check whether we require a scalar (length=1) and return
1177 ! an error if we do, and it isn't
1178 !
1179 
1180 if (present(scalar)) then !{
1181  if (scalar) then !{
1182  field_length = fm_get_length(name)
1183  if (field_length .lt. 0) then !{
1184  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
1185  elseif (field_length .gt. 1) then !}{
1186  call mpp_error(fatal, trim(error_header) // trim(name) // ' not scalar')
1187  endif !}
1188  endif !}
1189 endif !}
1190 
1191 !
1192 ! set the index
1193 !
1194 
1195 if (present(index)) then !{
1196  index_t = index
1197  if (index .le. 0) then !{
1198  call mpp_error(fatal, trim(error_header) // ' Index not positive')
1199  endif !}
1200 else !}{
1201  index_t = 1
1202 endif !}
1203 
1204 fm_type = fm_get_type(name)
1205 if (fm_type .eq. 'integer') then !{
1206  if (.not. fm_get_value(name, ival, index = index_t)) then !{
1207  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name))
1208  endif !}
1209 elseif (fm_type .eq. ' ' .and. present(default_value)) then !}{
1210  ival = default_value
1211 elseif (fm_type .eq. ' ') then !}{
1212  call mpp_error(fatal, trim(error_header) // ' Field does not exist: ' // trim(name))
1213 else !}{
1214  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
1215 endif !}
1216 
1217 return
1218 
1219 end function fm_util_get_integer !}
1220 
1221 !#######################################################################
1222 
1223 !> Get a logical value from the Field Manager tree.
1224 function fm_util_get_logical(name, caller, index, default_value, scalar) &
1225  result(lval) !{
1226 
1227 implicit none
1228 
1229 !
1230 ! Return type
1231 !
1232 
1233 logical :: lval
1234 
1235 !
1236 ! arguments
1237 !
1238 
1239 character(len=*), intent(in) :: name
1240 character(len=*), intent(in), optional :: caller
1241 integer, intent(in), optional :: index
1242 logical, intent(in), optional :: default_value
1243 logical, intent(in), optional :: scalar
1244 
1245 !
1246 ! Local parameters
1247 !
1248 
1249 character(len=48), parameter :: sub_name = 'fm_util_get_logical'
1250 
1251 !
1252 ! Local variables
1253 !
1254 
1255 character(len=256) :: error_header
1256 character(len=256) :: warn_header
1257 character(len=256) :: note_header
1258 character(len=128) :: caller_str
1259 integer :: index_t
1260 character(len=fm_type_name_len) :: fm_type
1261 integer :: field_length
1262 
1263 !
1264 ! set the caller string and headers
1265 !
1266 
1267 if (present(caller)) then !{
1268  caller_str = '[' // trim(caller) // ']'
1269 else !}{
1270  caller_str = fm_util_default_caller
1271 endif !}
1272 
1273 error_header = '==>Error from ' // trim(mod_name) // &
1274  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1275 warn_header = '==>Warning from ' // trim(mod_name) // &
1276  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1277 note_header = '==>Note from ' // trim(mod_name) // &
1278  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1279 
1280 !
1281 ! check that a name is given (fatal if not)
1282 !
1283 
1284 if (name .eq. ' ') then !{
1285  call mpp_error(fatal, trim(error_header) // ' Empty name given')
1286 endif !}
1287 
1288 !
1289 ! Check whether we require a scalar (length=1) and return
1290 ! an error if we do, and it isn't
1291 !
1292 
1293 if (present(scalar)) then !{
1294  if (scalar) then !{
1295  field_length = fm_get_length(name)
1296  if (field_length .lt. 0) then !{
1297  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
1298  elseif (field_length .gt. 1) then !}{
1299  call mpp_error(fatal, trim(error_header) // trim(name) // ' not scalar')
1300  endif !}
1301  endif !}
1302 endif !}
1303 
1304 !
1305 ! set the index
1306 !
1307 
1308 if (present(index)) then !{
1309  index_t = index
1310  if (index .le. 0) then !{
1311  call mpp_error(fatal, trim(error_header) // ' Index not positive')
1312  endif !}
1313 else !}{
1314  index_t = 1
1315 endif !}
1316 
1317 fm_type = fm_get_type(name)
1318 if (fm_type .eq. 'logical') then !{
1319  if (.not. fm_get_value(name, lval, index = index_t)) then !{
1320  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name))
1321  endif !}
1322 elseif (fm_type .eq. ' ' .and. present(default_value)) then !}{
1323  lval = default_value
1324 elseif (fm_type .eq. ' ') then !}{
1325  call mpp_error(fatal, trim(error_header) // ' Field does not exist: ' // trim(name))
1326 else !}{
1327  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
1328 endif !}
1329 
1330 return
1331 
1332 end function fm_util_get_logical !}
1333 
1334 !#######################################################################
1335 
1336 
1337 !> Get a real value from the Field Manager tree.
1338 function fm_util_get_real(name, caller, index, default_value, scalar) &
1339  result(rval) !{
1340 
1341 implicit none
1342 
1343 !
1344 ! Return type
1345 !
1346 
1347 real(r8_kind) :: rval
1348 
1349 !
1350 ! arguments
1351 !
1352 
1353 character(len=*), intent(in) :: name
1354 character(len=*), intent(in), optional :: caller
1355 integer, intent(in), optional :: index
1356 real(r8_kind), intent(in), optional :: default_value
1357 logical, intent(in), optional :: scalar
1358 
1359 !
1360 ! Local parameters
1361 !
1362 
1363 character(len=48), parameter :: sub_name = 'fm_util_get_real'
1364 
1365 !
1366 ! Local variables
1367 !
1368 
1369 character(len=256) :: error_header
1370 character(len=256) :: warn_header
1371 character(len=256) :: note_header
1372 character(len=128) :: caller_str
1373 integer :: index_t
1374 character(len=fm_type_name_len) :: fm_type
1375 integer :: field_length
1376 integer :: ivalue
1377 
1378 !
1379 ! set the caller string and headers
1380 !
1381 
1382 if (present(caller)) then !{
1383  caller_str = '[' // trim(caller) // ']'
1384 else !}{
1385  caller_str = fm_util_default_caller
1386 endif !}
1387 
1388 error_header = '==>Error from ' // trim(mod_name) // &
1389  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1390 warn_header = '==>Warning from ' // trim(mod_name) // &
1391  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1392 note_header = '==>Note from ' // trim(mod_name) // &
1393  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1394 
1395 !
1396 ! check that a name is given (fatal if not)
1397 !
1398 
1399 if (name .eq. ' ') then !{
1400  call mpp_error(fatal, trim(error_header) // ' Empty name given')
1401 endif !}
1402 
1403 !
1404 ! Check whether we require a scalar (length=1) and return
1405 ! an error if we do, and it isn't
1406 !
1407 
1408 if (present(scalar)) then !{
1409  if (scalar) then !{
1410  field_length = fm_get_length(name)
1411  if (field_length .lt. 0) then !{
1412  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
1413  elseif (field_length .gt. 1) then !}{
1414  call mpp_error(fatal, trim(error_header) // trim(name) // ' not scalar')
1415  endif !}
1416  endif !}
1417 endif !}
1418 
1419 !
1420 ! set the index
1421 !
1422 
1423 if (present(index)) then !{
1424  index_t = index
1425  if (index .le. 0) then !{
1426  call mpp_error(fatal, trim(error_header) // ' Index not positive')
1427  endif !}
1428 else !}{
1429  index_t = 1
1430 endif !}
1431 
1432 fm_type = fm_get_type(name)
1433 if (fm_type .eq. 'real') then !{
1434  if (.not. fm_get_value(name, rval, index = index_t)) then !{
1435  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name))
1436  endif !}
1437 else if (fm_type .eq. 'integer') then
1438  if (.not. fm_get_value(name, ivalue, index = index_t)) then
1439  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name))
1440  endif
1441  rval = real(ivalue,r8_kind)
1442 elseif (fm_type .eq. ' ' .and. present(default_value)) then !}{
1443  rval = default_value
1444 elseif (fm_type .eq. ' ') then !}{
1445  call mpp_error(fatal, trim(error_header) // ' Field does not exist: ' // trim(name))
1446 else !}{
1447  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
1448 endif !}
1449 
1450 return
1451 
1452 end function fm_util_get_real !}
1453 
1454 
1455 !#######################################################################
1456 
1457 
1458 !> Get a string value from the Field Manager tree.
1459 function fm_util_get_string(name, caller, index, default_value, scalar) &
1460  result(sval) !{
1461 
1462 implicit none
1463 
1464 !
1465 ! Return type
1466 !
1467 
1468 character(len=fm_string_len) :: sval
1469 
1470 !
1471 ! arguments
1472 !
1473 
1474 character(len=*), intent(in) :: name
1475 character(len=*), intent(in), optional :: caller
1476 integer, intent(in), optional :: index
1477 character(len=*), intent(in), optional :: default_value
1478 logical, intent(in), optional :: scalar
1479 
1480 !
1481 ! Local parameters
1482 !
1483 
1484 character(len=48), parameter :: sub_name = 'fm_util_get_string'
1485 
1486 !
1487 ! Local variables
1488 !
1489 
1490 character(len=256) :: error_header
1491 character(len=256) :: warn_header
1492 character(len=256) :: note_header
1493 character(len=128) :: caller_str
1494 integer :: index_t
1495 character(len=fm_type_name_len) :: fm_type
1496 integer :: field_length
1497 
1498 !
1499 ! set the caller string and headers
1500 !
1501 
1502 if (present(caller)) then !{
1503  caller_str = '[' // trim(caller) // ']'
1504 else !}{
1505  caller_str = fm_util_default_caller
1506 endif !}
1507 
1508 error_header = '==>Error from ' // trim(mod_name) // &
1509  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1510 warn_header = '==>Warning from ' // trim(mod_name) // &
1511  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1512 note_header = '==>Note from ' // trim(mod_name) // &
1513  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1514 
1515 !
1516 ! check that a name is given (fatal if not)
1517 !
1518 
1519 if (name .eq. ' ') then !{
1520  call mpp_error(fatal, trim(error_header) // ' Empty name given')
1521 endif !}
1522 
1523 !
1524 ! Check whether we require a scalar (length=1) and return
1525 ! an error if we do, and it isn't
1526 !
1527 
1528 if (present(scalar)) then !{
1529  if (scalar) then !{
1530  field_length = fm_get_length(name)
1531  if (field_length .lt. 0) then !{
1532  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
1533  elseif (field_length .gt. 1) then !}{
1534  call mpp_error(fatal, trim(error_header) // trim(name) // ' not scalar')
1535  endif !}
1536  endif !}
1537 endif !}
1538 
1539 !
1540 ! set the index
1541 !
1542 
1543 if (present(index)) then !{
1544  index_t = index
1545  if (index .le. 0) then !{
1546  call mpp_error(fatal, trim(error_header) // ' Index not positive')
1547  endif !}
1548 else !}{
1549  index_t = 1
1550 endif !}
1551 
1552 fm_type = fm_get_type(name)
1553 if (fm_type .eq. 'string') then !{
1554  if (.not. fm_get_value(name, sval, index = index_t)) then !{
1555  call mpp_error(fatal, trim(error_header) // ' Problem getting ' // trim(name))
1556  endif !}
1557 elseif (fm_type .eq. ' ' .and. present(default_value)) then !}{
1558  sval = default_value
1559 elseif (fm_type .eq. ' ') then !}{
1560  call mpp_error(fatal, trim(error_header) // ' Field does not exist: ' // trim(name))
1561 else !}{
1562  call mpp_error(fatal, trim(error_header) // ' Wrong type for ' // trim(name) // ', found (' // trim(fm_type) // ')')
1563 endif !}
1564 
1565 return
1566 
1567 end function fm_util_get_string !}
1568 
1569 !#######################################################################
1570 
1571 !> Set an integer array in the Field Manager tree.
1572 subroutine fm_util_set_value_integer_array(name, ival, length, caller, no_overwrite, good_name_list) !{
1573 
1574 implicit none
1575 
1576 !
1577 ! arguments
1578 !
1579 
1580 character(len=*), intent(in) :: name
1581 integer, intent(in) :: length
1582 integer, intent(in) :: ival(length)
1583 character(len=*), intent(in), optional :: caller
1584 logical, intent(in), optional :: no_overwrite
1585 character(len=*), intent(in), optional :: good_name_list
1586 
1587 !
1588 ! Local parameters
1589 !
1590 
1591 character(len=48), parameter :: sub_name = 'fm_util_set_value_integer_array'
1592 
1593 !
1594 ! Local variables
1595 !
1596 
1597 character(len=256) :: error_header
1598 character(len=256) :: warn_header
1599 character(len=256) :: note_header
1600 character(len=128) :: caller_str
1601 character(len=32) :: str_error
1602 integer :: field_index
1603 integer :: field_length
1604 integer :: n
1605 logical :: no_overwrite_use
1606 character(len=FMS_PATH_LEN) :: good_name_list_use
1607 logical :: add_name
1608 
1609 !
1610 ! set the caller string and headers
1611 !
1612 
1613 if (present(caller)) then !{
1614  caller_str = '[' // trim(caller) // ']'
1615 else !}{
1616  caller_str = fm_util_default_caller
1617 endif !}
1618 
1619 error_header = '==>Error from ' // trim(mod_name) // &
1620  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1621 warn_header = '==>Warning from ' // trim(mod_name) // &
1622  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1623 note_header = '==>Note from ' // trim(mod_name) // &
1624  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1625 
1626 !
1627 ! check that a name is given (fatal if not)
1628 !
1629 
1630 if (name .eq. ' ') then !{
1631  call mpp_error(fatal, trim(error_header) // ' Empty name given')
1632 endif !}
1633 
1634 !
1635 ! check that the length is non-negative
1636 !
1637 
1638 if (length .lt. 0) then !{
1639  call mpp_error(fatal, trim(error_header) // ' Negative array length')
1640 endif !}
1641 
1642 !
1643 ! check for whether to overwrite existing values
1644 !
1645 
1646 if (present(no_overwrite)) then !{
1647  no_overwrite_use = no_overwrite
1648 else !}{
1649  no_overwrite_use = default_no_overwrite
1650 endif !}
1651 
1652 !
1653 ! check for whether to save the name in a list
1654 !
1655 
1656 if (present(good_name_list)) then !{
1657  good_name_list_use = good_name_list
1658 else !}{
1659  good_name_list_use = default_good_name_list
1660 endif !}
1661 
1662 !
1663 ! write the data array
1664 !
1665 
1666 if (length .eq. 0) then !{
1667  if (.not. (no_overwrite_use .and. fm_exists(name))) then !{
1668  field_index = fm_new_value(name, 0, index = 0)
1669  if (field_index .le. 0) then !{
1670  write (str_error,*) ' with length = ', length
1671  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
1672  endif !}
1673  endif !}
1674 else !}{
1675  if (no_overwrite_use .and. fm_exists(name)) then !{
1676  field_length = fm_get_length(name)
1677  if (field_length .lt. 0) then !{
1678  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
1679  endif !}
1680  do n = field_length + 1, length !{
1681  field_index = fm_new_value(name, ival(n), index = n)
1682  if (field_index .le. 0) then !{
1683  write (str_error,*) ' with index = ', n
1684  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
1685  endif !}
1686  enddo !} n
1687  else !}{
1688  field_index = fm_new_value(name, ival(1))
1689  if (field_index .le. 0) then !{
1690  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name))
1691  endif !}
1692  do n = 2, length !{
1693  field_index = fm_new_value(name, ival(n), index = n)
1694  if (field_index .le. 0) then !{
1695  write (str_error,*) ' with index = ', n
1696  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
1697  endif !}
1698  enddo !} n
1699  endif !}
1700 endif !}
1701 
1702 !
1703 ! Add the variable name to the list of good names, to be used
1704 ! later for a consistency check
1705 !
1706 
1707 if (good_name_list_use .ne. ' ') then !{
1708  if (fm_exists(good_name_list_use)) then !{
1709  add_name = fm_util_get_index_string(good_name_list_use, name, &
1710  caller = caller_str) .le. 0 ! true if name does not exist in string array
1711  else !}{
1712  add_name = .true. ! always add to new list
1713  endif !}
1714  if (add_name .and. fm_exists(name)) then !{
1715  if (fm_new_value(good_name_list_use, name, append = .true., create = .true.) .le. 0) then !{
1716  call mpp_error(fatal, trim(error_header) // &
1717  ' Could not add ' // trim(name) // ' to "' // trim(good_name_list_use) // '" list')
1718  endif !}
1719  endif !}
1720 endif !}
1721 
1722 return
1723 
1724 end subroutine fm_util_set_value_integer_array !}
1725 
1726 !#######################################################################
1727 
1728 !> Set a logical array in the Field Manager tree.
1729 subroutine fm_util_set_value_logical_array(name, lval, length, caller, no_overwrite, good_name_list) !{
1730 
1731 implicit none
1732 
1733 !
1734 ! arguments
1735 !
1736 
1737 character(len=*), intent(in) :: name
1738 integer, intent(in) :: length
1739 logical, intent(in) :: lval(length)
1740 character(len=*), intent(in), optional :: caller
1741 logical, intent(in), optional :: no_overwrite
1742 character(len=*), intent(in), optional :: good_name_list
1743 
1744 !
1745 ! Local parameters
1746 !
1747 
1748 character(len=48), parameter :: sub_name = 'fm_util_set_value_logical_array'
1749 
1750 !
1751 ! Local variables
1752 !
1753 
1754 character(len=256) :: error_header
1755 character(len=256) :: warn_header
1756 character(len=256) :: note_header
1757 character(len=128) :: caller_str
1758 character(len=32) :: str_error
1759 integer :: field_index
1760 integer :: field_length
1761 integer :: n
1762 logical :: no_overwrite_use
1763 character(len=FMS_PATH_LEN) :: good_name_list_use
1764 logical :: add_name
1765 
1766 !
1767 ! set the caller string and headers
1768 !
1769 
1770 if (present(caller)) then !{
1771  caller_str = '[' // trim(caller) // ']'
1772 else !}{
1773  caller_str = fm_util_default_caller
1774 endif !}
1775 
1776 error_header = '==>Error from ' // trim(mod_name) // &
1777  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1778 warn_header = '==>Warning from ' // trim(mod_name) // &
1779  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1780 note_header = '==>Note from ' // trim(mod_name) // &
1781  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1782 
1783 !
1784 ! check that a name is given (fatal if not)
1785 !
1786 
1787 if (name .eq. ' ') then !{
1788  call mpp_error(fatal, trim(error_header) // ' Empty name given')
1789 endif !}
1790 
1791 !
1792 ! check that the length is non-negative
1793 !
1794 
1795 if (length .lt. 0) then !{
1796  call mpp_error(fatal, trim(error_header) // ' Negative array length')
1797 endif !}
1798 
1799 !
1800 ! check for whether to overwrite existing values
1801 !
1802 
1803 if (present(no_overwrite)) then !{
1804  no_overwrite_use = no_overwrite
1805 else !}{
1806  no_overwrite_use = default_no_overwrite
1807 endif !}
1808 
1809 !
1810 ! check for whether to save the name in a list
1811 !
1812 
1813 if (present(good_name_list)) then !{
1814  good_name_list_use = good_name_list
1815 else !}{
1816  good_name_list_use = default_good_name_list
1817 endif !}
1818 
1819 !
1820 ! write the data array
1821 !
1822 
1823 if (length .eq. 0) then !{
1824  if (.not. (no_overwrite_use .and. fm_exists(name))) then !{
1825  field_index = fm_new_value(name, .false., index = 0)
1826  if (field_index .le. 0) then !{
1827  write (str_error,*) ' with length = ', length
1828  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
1829  endif !}
1830  endif !}
1831 else !}{
1832  if (no_overwrite_use .and. fm_exists(name)) then !{
1833  field_length = fm_get_length(name)
1834  if (field_length .lt. 0) then !{
1835  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
1836  endif !}
1837  do n = field_length + 1, length !{
1838  field_index = fm_new_value(name, lval(n), index = n)
1839  if (field_index .le. 0) then !{
1840  write (str_error,*) ' with index = ', n
1841  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
1842  endif !}
1843  enddo !} n
1844  else !}{
1845  field_index = fm_new_value(name, lval(1))
1846  if (field_index .le. 0) then !{
1847  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name))
1848  endif !}
1849  do n = 2, length !{
1850  field_index = fm_new_value(name, lval(n), index = n)
1851  if (field_index .le. 0) then !{
1852  write (str_error,*) ' with index = ', n
1853  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
1854  endif !}
1855  enddo !} n
1856  endif !}
1857 endif !}
1858 
1859 !
1860 ! Add the variable name to the list of good names, to be used
1861 ! later for a consistency check
1862 !
1863 
1864 if (good_name_list_use .ne. ' ') then !{
1865  if (fm_exists(good_name_list_use)) then !{
1866  add_name = fm_util_get_index_string(good_name_list_use, name, &
1867  caller = caller_str) .le. 0 ! true if name does not exist in string array
1868  else !}{
1869  add_name = .true. ! always add to new list
1870  endif !}
1871  if (add_name .and. fm_exists(name)) then !{
1872  if (fm_new_value(good_name_list_use, name, append = .true., create = .true.) .le. 0) then !{
1873  call mpp_error(fatal, trim(error_header) // &
1874  ' Could not add ' // trim(name) // ' to "' // trim(good_name_list_use) // '" list')
1875  endif !}
1876  endif !}
1877 endif !}
1878 
1879 return
1880 
1881 end subroutine fm_util_set_value_logical_array !}
1882 
1883 !#######################################################################
1884 
1885 !> Set a string array in the Field Manager tree.
1886 subroutine fm_util_set_value_string_array(name, sval, length, caller, no_overwrite, good_name_list) !{
1887 
1888 implicit none
1889 
1890 !
1891 ! arguments
1892 !
1893 
1894 character(len=*), intent(in) :: name
1895 integer, intent(in) :: length
1896 character(len=*), intent(in) :: sval(length)
1897 character(len=*), intent(in), optional :: caller
1898 logical, intent(in), optional :: no_overwrite
1899 character(len=*), intent(in), optional :: good_name_list
1900 
1901 !
1902 ! Local parameters
1903 !
1904 
1905 character(len=48), parameter :: sub_name = 'fm_util_set_value_string_array'
1906 
1907 !
1908 ! Local variables
1909 !
1910 
1911 character(len=256) :: error_header
1912 character(len=256) :: warn_header
1913 character(len=256) :: note_header
1914 character(len=128) :: caller_str
1915 character(len=32) :: str_error
1916 integer :: field_index
1917 integer :: field_length
1918 integer :: n
1919 logical :: no_overwrite_use
1920 character(len=FMS_PATH_LEN) :: good_name_list_use
1921 logical :: add_name
1922 
1923 !
1924 ! set the caller string and headers
1925 !
1926 
1927 if (present(caller)) then !{
1928  caller_str = '[' // trim(caller) // ']'
1929 else !}{
1930  caller_str = fm_util_default_caller
1931 endif !}
1932 
1933 error_header = '==>Error from ' // trim(mod_name) // &
1934  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1935 warn_header = '==>Warning from ' // trim(mod_name) // &
1936  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1937 note_header = '==>Note from ' // trim(mod_name) // &
1938  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
1939 
1940 !
1941 ! check that a name is given (fatal if not)
1942 !
1943 
1944 if (name .eq. ' ') then !{
1945  call mpp_error(fatal, trim(error_header) // ' Empty name given')
1946 endif !}
1947 
1948 !
1949 ! check that the length is non-negative
1950 !
1951 
1952 if (length .lt. 0) then !{
1953  call mpp_error(fatal, trim(error_header) // ' Negative array length')
1954 endif !}
1955 
1956 !
1957 ! check for whether to overwrite existing values
1958 !
1959 
1960 if (present(no_overwrite)) then !{
1961  no_overwrite_use = no_overwrite
1962 else !}{
1963  no_overwrite_use = default_no_overwrite
1964 endif !}
1965 
1966 !
1967 ! check for whether to save the name in a list
1968 !
1969 
1970 if (present(good_name_list)) then !{
1971  good_name_list_use = good_name_list
1972 else !}{
1973  good_name_list_use = default_good_name_list
1974 endif !}
1975 
1976 !
1977 ! write the data array
1978 !
1979 
1980 if (length .eq. 0) then !{
1981  if (.not. (no_overwrite_use .and. fm_exists(name))) then !{
1982  field_index = fm_new_value(name, ' ', index = 0)
1983  if (field_index .le. 0) then !{
1984  write (str_error,*) ' with length = ', length
1985  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
1986  endif !}
1987  endif !}
1988 else !}{
1989  if (no_overwrite_use .and. fm_exists(name)) then !{
1990  field_length = fm_get_length(name)
1991  if (field_length .lt. 0) then !{
1992  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
1993  endif !}
1994  do n = field_length + 1, length !{
1995  field_index = fm_new_value(name, sval(n), index = n)
1996  if (field_index .le. 0) then !{
1997  write (str_error,*) ' with index = ', n
1998  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
1999  endif !}
2000  enddo !} n
2001  else !}{
2002  field_index = fm_new_value(name, sval(1))
2003  if (field_index .le. 0) then !{
2004  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name))
2005  endif !}
2006  do n = 2, length !{
2007  field_index = fm_new_value(name, sval(n), index = n)
2008  if (field_index .le. 0) then !{
2009  write (str_error,*) ' with index = ', n
2010  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
2011  endif !}
2012  enddo !} n
2013  endif !}
2014 endif !}
2015 
2016 !
2017 ! Add the variable name to the list of good names, to be used
2018 ! later for a consistency check
2019 !
2020 
2021 if (good_name_list_use .ne. ' ') then !{
2022  if (fm_exists(good_name_list_use)) then !{
2023  add_name = fm_util_get_index_string(good_name_list_use, name, &
2024  caller = caller_str) .le. 0 ! true if name does not exist in string array
2025  else !}{
2026  add_name = .true. ! always add to new list
2027  endif !}
2028  if (add_name .and. fm_exists(name)) then !{
2029  if (fm_new_value(good_name_list_use, name, append = .true., create = .true.) .le. 0) then !{
2030  call mpp_error(fatal, trim(error_header) // &
2031  ' Could not add ' // trim(name) // ' to "' // trim(good_name_list_use) // '" list')
2032  endif !}
2033  endif !}
2034 endif !}
2035 
2036 return
2037 
2038 end subroutine fm_util_set_value_string_array !}
2039 
2040 !#######################################################################
2041 
2042 !> Set an integer value in the Field Manager tree.
2043 subroutine fm_util_set_value_integer(name, ival, caller, index, append, no_create, &
2044  no_overwrite, good_name_list) !{
2045 
2046 implicit none
2047 
2048 !
2049 ! arguments
2050 !
2051 
2052 character(len=*), intent(in) :: name
2053 integer, intent(in) :: ival
2054 character(len=*), intent(in), optional :: caller
2055 integer, intent(in), optional :: index
2056 logical, intent(in), optional :: append
2057 logical, intent(in), optional :: no_create
2058 logical, intent(in), optional :: no_overwrite
2059 character(len=*), intent(in), optional :: good_name_list
2060 
2061 !
2062 ! Local parameters
2063 !
2064 
2065 character(len=48), parameter :: sub_name = 'fm_util_set_value_integer'
2066 
2067 !
2068 ! Local variables
2069 !
2070 
2071 character(len=256) :: error_header
2072 character(len=256) :: warn_header
2073 character(len=256) :: note_header
2074 character(len=128) :: caller_str
2075 character(len=32) :: str_error
2076 integer :: field_index
2077 logical :: no_overwrite_use
2078 integer :: field_length
2079 character(len=FMS_PATH_LEN) :: good_name_list_use
2080 logical :: create
2081 logical :: add_name
2082 
2083 !
2084 ! set the caller string and headers
2085 !
2086 
2087 if (present(caller)) then !{
2088  caller_str = '[' // trim(caller) // ']'
2089 else !}{
2090  caller_str = fm_util_default_caller
2091 endif !}
2092 
2093 error_header = '==>Error from ' // trim(mod_name) // &
2094  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2095 warn_header = '==>Warning from ' // trim(mod_name) // &
2096  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2097 note_header = '==>Note from ' // trim(mod_name) // &
2098  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2099 
2100 !
2101 ! check that a name is given (fatal if not)
2102 !
2103 
2104 if (name .eq. ' ') then !{
2105  call mpp_error(fatal, trim(error_header) // ' Empty name given')
2106 endif !}
2107 
2108 !
2109 ! check that append and index are not both given
2110 !
2111 
2112 if (present(index) .and. present(append)) then !{
2113  call mpp_error(fatal, trim(error_header) // ' Append and index both given as arguments')
2114 endif !}
2115 
2116 !
2117 ! check for whether to overwrite existing values
2118 !
2119 
2120 if (present(no_overwrite)) then !{
2121  no_overwrite_use = no_overwrite
2122 else !}{
2123  no_overwrite_use = default_no_overwrite
2124 endif !}
2125 
2126 !
2127 ! check for whether to save the name in a list
2128 !
2129 
2130 if (present(good_name_list)) then !{
2131  good_name_list_use = good_name_list
2132 else !}{
2133  good_name_list_use = default_good_name_list
2134 endif !}
2135 
2136 if (present(no_create)) then !{
2137  create = .not. no_create
2138  if (no_create .and. (present(append) .or. present(index))) then !{
2139  call mpp_error(fatal, trim(error_header) // &
2140  & ' append or index are present when no_create is true for ' // trim(name))
2141  endif !}
2142 else !}{
2143  create = .true.
2144 endif !}
2145 
2146 if (present(index)) then !{
2147  if (fm_exists(name)) then !{
2148  field_length = fm_get_length(name)
2149  if (field_length .lt. 0) then !{
2150  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
2151  endif !}
2152  if (.not. (no_overwrite_use .and. field_length .ge. index)) then !{
2153  field_index = fm_new_value(name, ival, index = index)
2154  if (field_index .le. 0) then !{
2155  write (str_error,*) ' with index = ', index
2156  call mpp_error(fatal, trim(error_header) // ' Problem overwriting ' // trim(name) // trim(str_error))
2157  endif !}
2158  endif !}
2159  else !}{
2160  field_index = fm_new_value(name, ival, index = index)
2161  if (field_index .le. 0) then !{
2162  write (str_error,*) ' with index = ', index
2163  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
2164  endif !}
2165  endif !}
2166 elseif (present(append)) then !}{
2167  field_index = fm_new_value(name, ival, append = append)
2168  if (field_index .le. 0) then !{
2169  write (str_error,*) ' with append = ', append
2170  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
2171  endif !}
2172 else !}{
2173  if (fm_exists(name)) then !{
2174  if (.not. no_overwrite_use) then !{
2175  field_index = fm_new_value(name, ival)
2176  if (field_index .le. 0) then !{
2177  call mpp_error(fatal, trim(error_header) // ' Problem overwriting ' // trim(name))
2178  endif !}
2179  endif !}
2180  elseif (create) then !}{
2181  field_index = fm_new_value(name, ival)
2182  if (field_index .le. 0) then !{
2183  call mpp_error(fatal, trim(error_header) // ' Problem creating ' // trim(name))
2184  endif !}
2185  endif !}
2186 endif !}
2187 
2188 !
2189 ! Add the variable name to the list of good names, to be used
2190 ! later for a consistency check, unless the field did not exist and we did not create it
2191 !
2192 
2193 if (good_name_list_use .ne. ' ') then !{
2194  if (fm_exists(good_name_list_use)) then !{
2195  add_name = fm_util_get_index_string(good_name_list_use, name, &
2196  caller = caller_str) .le. 0 ! true if name does not exist in string array
2197  else !}{
2198  add_name = .true. ! always add to new list
2199  endif !}
2200  if (add_name .and. fm_exists(name)) then !{
2201  if (fm_new_value(good_name_list_use, name, append = .true., create = .true.) .le. 0) then !{
2202  call mpp_error(fatal, trim(error_header) // &
2203  ' Could not add ' // trim(name) // ' to "' // trim(good_name_list_use) // '" list')
2204  endif !}
2205  endif !}
2206 endif !}
2207 
2208 return
2209 
2210 end subroutine fm_util_set_value_integer !}
2211 
2212 !#######################################################################
2213 
2214 !> Set a logical value in the Field Manager tree.
2215 subroutine fm_util_set_value_logical(name, lval, caller, index, append, no_create, &
2216  no_overwrite, good_name_list) !{
2217 
2218 implicit none
2219 
2220 !
2221 ! arguments
2222 !
2223 
2224 character(len=*), intent(in) :: name
2225 logical, intent(in) :: lval
2226 character(len=*), intent(in), optional :: caller
2227 integer, intent(in), optional :: index
2228 logical, intent(in), optional :: append
2229 logical, intent(in), optional :: no_create
2230 logical, intent(in), optional :: no_overwrite
2231 character(len=*), intent(in), optional :: good_name_list
2232 
2233 !
2234 ! Local parameters
2235 !
2236 
2237 character(len=48), parameter :: sub_name = 'fm_util_set_value_logical'
2238 
2239 !
2240 ! Local variables
2241 !
2242 
2243 character(len=256) :: error_header
2244 character(len=256) :: warn_header
2245 character(len=256) :: note_header
2246 character(len=128) :: caller_str
2247 character(len=32) :: str_error
2248 integer :: field_index
2249 logical :: no_overwrite_use
2250 integer :: field_length
2251 character(len=FMS_PATH_LEN) :: good_name_list_use
2252 logical :: create
2253 logical :: add_name
2254 
2255 !
2256 ! set the caller string and headers
2257 !
2258 
2259 if (present(caller)) then !{
2260  caller_str = '[' // trim(caller) // ']'
2261 else !}{
2262  caller_str = fm_util_default_caller
2263 endif !}
2264 
2265 error_header = '==>Error from ' // trim(mod_name) // &
2266  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2267 warn_header = '==>Warning from ' // trim(mod_name) // &
2268  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2269 note_header = '==>Note from ' // trim(mod_name) // &
2270  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2271 
2272 !
2273 ! check that a name is given (fatal if not)
2274 !
2275 
2276 if (name .eq. ' ') then !{
2277  call mpp_error(fatal, trim(error_header) // ' Empty name given')
2278 endif !}
2279 
2280 !
2281 ! check that append and index are not both given
2282 !
2283 
2284 if (present(index) .and. present(append)) then !{
2285  call mpp_error(fatal, trim(error_header) // ' Append and index both given as arguments')
2286 endif !}
2287 
2288 !
2289 ! check for whether to overwrite existing values
2290 !
2291 
2292 if (present(no_overwrite)) then !{
2293  no_overwrite_use = no_overwrite
2294 else !}{
2295  no_overwrite_use = default_no_overwrite
2296 endif !}
2297 
2298 !
2299 ! check for whether to save the name in a list
2300 !
2301 
2302 if (present(good_name_list)) then !{
2303  good_name_list_use = good_name_list
2304 else !}{
2305  good_name_list_use = default_good_name_list
2306 endif !}
2307 
2308 if (present(no_create)) then !{
2309  create = .not. no_create
2310  if (no_create .and. (present(append) .or. present(index))) then !{
2311  call mpp_error(fatal, trim(error_header) // &
2312  & ' append or index are present when no_create is true for ' // trim(name))
2313  endif !}
2314 else !}{
2315  create = .true.
2316 endif !}
2317 
2318 if (present(index)) then !{
2319  if (fm_exists(name)) then !{
2320  field_length = fm_get_length(name)
2321  if (field_length .lt. 0) then !{
2322  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
2323  endif !}
2324  if (.not. (no_overwrite_use .and. field_length .ge. index)) then !{
2325  field_index = fm_new_value(name, lval, index = index)
2326  if (field_index .le. 0) then !{
2327  write (str_error,*) ' with index = ', index
2328  call mpp_error(fatal, trim(error_header) // ' Problem overwriting ' // trim(name) // trim(str_error))
2329  endif !}
2330  endif !}
2331  else !}{
2332  field_index = fm_new_value(name, lval, index = index)
2333  if (field_index .le. 0) then !{
2334  write (str_error,*) ' with index = ', index
2335  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
2336  endif !}
2337  endif !}
2338 elseif (present(append)) then !}{
2339  field_index = fm_new_value(name, lval, append = append)
2340  if (field_index .le. 0) then !{
2341  write (str_error,*) ' with append = ', append
2342  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
2343  endif !}
2344 else !}{
2345  if (fm_exists(name)) then !{
2346  if (.not. no_overwrite_use) then !{
2347  field_index = fm_new_value(name, lval)
2348  if (field_index .le. 0) then !{
2349  call mpp_error(fatal, trim(error_header) // ' Problem overwriting ' // trim(name))
2350  endif !}
2351  endif !}
2352  elseif (create) then !}{
2353  field_index = fm_new_value(name, lval)
2354  if (field_index .le. 0) then !{
2355  call mpp_error(fatal, trim(error_header) // ' Problem creating ' // trim(name))
2356  endif !}
2357  endif !}
2358 endif !}
2359 
2360 !
2361 ! Add the variable name to the list of good names, to be used
2362 ! later for a consistency check, unless the field did not exist and we did not create it
2363 !
2364 
2365 if (good_name_list_use .ne. ' ') then !{
2366  if (fm_exists(good_name_list_use)) then !{
2367  add_name = fm_util_get_index_string(good_name_list_use, name, &
2368  caller = caller_str) .le. 0 ! true if name does not exist in string array
2369  else !}{
2370  add_name = .true. ! always add to new list
2371  endif !}
2372  if (add_name .and. fm_exists(name)) then !{
2373  if (fm_new_value(good_name_list_use, name, append = .true., create = .true.) .le. 0) then !{
2374  call mpp_error(fatal, trim(error_header) // &
2375  ' Could not add ' // trim(name) // ' to "' // trim(good_name_list_use) // '" list')
2376  endif !}
2377  endif !}
2378 endif !}
2379 
2380 return
2381 
2382 end subroutine fm_util_set_value_logical !}
2383 
2384 !#######################################################################
2385 !> Set a string value in the Field Manager tree.
2386 subroutine fm_util_set_value_string(name, sval, caller, index, append, no_create, &
2387  no_overwrite, good_name_list) !{
2388 
2389 implicit none
2390 
2391 !
2392 ! arguments
2393 !
2394 
2395 character(len=*), intent(in) :: name
2396 character(len=*), intent(in) :: sval
2397 character(len=*), intent(in), optional :: caller
2398 integer, intent(in), optional :: index
2399 logical, intent(in), optional :: append
2400 logical, intent(in), optional :: no_create
2401 logical, intent(in), optional :: no_overwrite
2402 character(len=*), intent(in), optional :: good_name_list
2403 
2404 !
2405 ! Local parameters
2406 !
2407 
2408 character(len=48), parameter :: sub_name = 'fm_util_set_value_string'
2409 
2410 !
2411 ! Local variables
2412 !
2413 
2414 character(len=256) :: error_header
2415 character(len=256) :: warn_header
2416 character(len=256) :: note_header
2417 character(len=128) :: caller_str
2418 character(len=32) :: str_error
2419 integer :: field_index
2420 logical :: no_overwrite_use
2421 integer :: field_length
2422 character(len=FMS_PATH_LEN) :: good_name_list_use
2423 logical :: create
2424 logical :: add_name
2425 
2426 !
2427 ! set the caller string and headers
2428 !
2429 
2430 if (present(caller)) then !{
2431  caller_str = '[' // trim(caller) // ']'
2432 else !}{
2433  caller_str = fm_util_default_caller
2434 endif !}
2435 
2436 error_header = '==>Error from ' // trim(mod_name) // &
2437  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2438 warn_header = '==>Warning from ' // trim(mod_name) // &
2439  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2440 note_header = '==>Note from ' // trim(mod_name) // &
2441  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2442 
2443 !
2444 ! check that a name is given (fatal if not)
2445 !
2446 
2447 if (name .eq. ' ') then !{
2448  call mpp_error(fatal, trim(error_header) // ' Empty name given')
2449 endif !}
2450 
2451 !
2452 ! check that append and index are not both given
2453 !
2454 
2455 if (present(index) .and. present(append)) then !{
2456  call mpp_error(fatal, trim(error_header) // ' Append and index both given as arguments')
2457 endif !}
2458 
2459 !
2460 ! check for whether to overwrite existing values
2461 !
2462 
2463 if (present(no_overwrite)) then !{
2464  no_overwrite_use = no_overwrite
2465 else !}{
2466  no_overwrite_use = default_no_overwrite
2467 endif !}
2468 
2469 !
2470 ! check for whether to save the name in a list
2471 !
2472 
2473 if (present(good_name_list)) then !{
2474  good_name_list_use = good_name_list
2475 else !}{
2476  good_name_list_use = default_good_name_list
2477 endif !}
2478 
2479 if (present(no_create)) then !{
2480  create = .not. no_create
2481  if (no_create .and. (present(append) .or. present(index))) then !{
2482  call mpp_error(fatal, trim(error_header) // &
2483  & ' append or index are present when no_create is true for ' // trim(name))
2484  endif !}
2485 else !}{
2486  create = .true.
2487 endif !}
2488 
2489 if (present(index)) then !{
2490  if (fm_exists(name)) then !{
2491  field_length = fm_get_length(name)
2492  if (field_length .lt. 0) then !{
2493  call mpp_error(fatal, trim(error_header) // ' Problem getting length of ' // trim(name))
2494  endif !}
2495  if (.not. (no_overwrite_use .and. field_length .ge. index)) then !{
2496  field_index = fm_new_value(name, sval, index = index)
2497  if (field_index .le. 0) then !{
2498  write (str_error,*) ' with index = ', index
2499  call mpp_error(fatal, trim(error_header) // ' Problem overwriting ' // trim(name) // trim(str_error))
2500  endif !}
2501  endif !}
2502  else !}{
2503  field_index = fm_new_value(name, sval, index = index)
2504  if (field_index .le. 0) then !{
2505  write (str_error,*) ' with index = ', index
2506  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
2507  endif !}
2508  endif !}
2509 elseif (present(append)) then !}{
2510  field_index = fm_new_value(name, sval, append = append)
2511  if (field_index .le. 0) then !{
2512  write (str_error,*) ' with append = ', append
2513  call mpp_error(fatal, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error))
2514  endif !}
2515 else !}{
2516  if (fm_exists(name)) then !{
2517  if (.not. no_overwrite_use) then !{
2518  field_index = fm_new_value(name, sval)
2519  if (field_index .le. 0) then !{
2520  call mpp_error(fatal, trim(error_header) // ' Problem overwriting ' // trim(name))
2521  endif !}
2522  endif !}
2523  elseif (create) then !}{
2524  field_index = fm_new_value(name, sval)
2525  if (field_index .le. 0) then !{
2526  call mpp_error(fatal, trim(error_header) // ' Problem creating ' // trim(name))
2527  endif !}
2528  endif !}
2529 endif !}
2530 
2531 !
2532 ! Add the variable name to the list of good names, to be used
2533 ! later for a consistency check, unless the field did not exist and we did not create it
2534 !
2535 
2536 if (good_name_list_use .ne. ' ') then !{
2537  if (fm_exists(good_name_list_use)) then !{
2538  add_name = fm_util_get_index_string(good_name_list_use, name, &
2539  caller = caller_str) .le. 0 ! true if name does not exist in string array
2540  else !}{
2541  add_name = .true. ! always add to new list
2542  endif !}
2543  if (add_name .and. fm_exists(name)) then !{
2544  if (fm_new_value(good_name_list_use, name, append = .true., create = .true.) .le. 0) then !{
2545  call mpp_error(fatal, trim(error_header) // &
2546  ' Could not add ' // trim(name) // ' to "' // trim(good_name_list_use) // '" list')
2547  endif !}
2548  endif !}
2549 endif !}
2550 
2551 return
2552 
2553 end subroutine fm_util_set_value_string !}
2554 
2555 !#######################################################################
2556 
2557 !> Start processing a namelist
2558 subroutine fm_util_start_namelist(path, name, caller, no_overwrite, check) !{
2559 
2560 implicit none
2561 
2562 !
2563 ! arguments
2564 !
2565 
2566 character(len=*), intent(in) :: path
2567 character(len=*), intent(in) :: name
2568 character(len=*), intent(in), optional :: caller
2569 logical, intent(in), optional :: no_overwrite
2570 logical, intent(in), optional :: check
2571 
2572 !
2573 ! Local parameters
2574 !
2575 
2576 character(len=48), parameter :: sub_name = 'fm_util_start_namelist'
2577 
2578 !
2579 ! Local variables
2580 !
2581 
2582 integer :: namelist_index
2583 character(len=FMS_PATH_LEN) :: path_name
2584 character(len=256) :: error_header
2585 character(len=256) :: warn_header
2586 character(len=256) :: note_header
2587 character(len=128) :: caller_str
2588 integer :: out_unit
2589 
2590 out_unit = stdout()
2591 
2592 !
2593 ! set the caller string and headers
2594 !
2595 
2596 if (present(caller)) then !{
2597  caller_str = '[' // trim(caller) // ']'
2598 else !}{
2599  caller_str = fm_util_default_caller
2600 endif !}
2601 
2602 error_header = '==>Error from ' // trim(mod_name) // &
2603  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2604 warn_header = '==>Warning from ' // trim(mod_name) // &
2605  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2606 note_header = '==>Note from ' // trim(mod_name) // &
2607  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2608 
2609 !
2610 ! check that a name is given (fatal if not)
2611 !
2612 
2613 if (name .eq. ' ') then !{
2614  call mpp_error(fatal, trim(error_header) // ' Empty name given')
2615 endif !}
2616 
2617 !
2618 ! Concatenate the path and name
2619 !
2620 
2621 if (path .eq. ' ') then !{
2622  path_name = name
2623 else !}{
2624  path_name = trim(path) // '/' // name
2625 endif !}
2626 save_path = path
2627 save_name = name
2628 
2629 !
2630 ! set the default caller string, if desired
2631 !
2632 
2633 if (present(caller)) then !{
2634  call fm_util_set_caller(caller)
2635 else !}{
2636  call fm_util_reset_caller
2637 endif !}
2638 
2639 !
2640 ! set the default no_overwrite flag, if desired
2641 !
2642 
2643 if (present(no_overwrite)) then !{
2644  call fm_util_set_no_overwrite(no_overwrite)
2645 else !}{
2646  call fm_util_reset_no_overwrite
2647 endif !}
2648 
2649 !
2650 ! set the default good_name_list string, if desired
2651 !
2652 
2653 if (present(check)) then !{
2654  if (check) then !{
2655  call fm_util_set_good_name_list('/ocean_mod/GOOD/namelists/' // trim(path_name) // '/good_list')
2656  else !}{
2657  call fm_util_reset_good_name_list
2658  endif !}
2659 else !}{
2660  call fm_util_reset_good_name_list
2661 endif !}
2662 
2663 !
2664 ! Process the namelist
2665 !
2666 
2667 write (out_unit,*)
2668 write (out_unit,*) trim(note_header), ' Processing namelist ', trim(path_name)
2669 
2670 !
2671 ! Check whether the namelist already exists. If so, then use that one
2672 !
2673 
2674 namelist_index = fm_get_index('/ocean_mod/namelists/' // trim(path_name))
2675 if (namelist_index .gt. 0) then !{
2676 
2677  !write (out_unit,*) trim(note_header), ' Namelist already set with index ', namelist_index
2678 
2679 else !}{
2680 
2681 !
2682 ! Set a new namelist and get its index
2683 !
2684 
2685  namelist_index = fm_new_list('/ocean_mod/namelists/' // trim(path_name), create = .true.)
2686  if (namelist_index .le. 0) then !{
2687  call mpp_error(fatal, trim(error_header) // ' Could not set namelist ' // trim(path_name))
2688  endif !}
2689 
2690 endif !}
2691 
2692 !
2693 ! Add the namelist name to the list of good namelists, to be used
2694 ! later for a consistency check
2695 !
2696 
2697 if (fm_new_value('/ocean_mod/GOOD/namelists/' // trim(path) // '/good_values', &
2698  name, append = .true., create = .true.) .le. 0) then !{
2699  call mpp_error(fatal, trim(error_header) // &
2700  ' Could not add ' // trim(name) // ' to "' // trim(path) // '/good_values" list')
2701 endif !}
2702 
2703 !
2704 ! Change to the new namelist, first saving the current list
2705 !
2706 
2707 save_current_list = fm_get_current_list()
2708 if (save_current_list .eq. ' ') then !{
2709  call mpp_error(fatal, trim(error_header) // ' Could not get the current list')
2710 endif !}
2711 
2712 if (.not. fm_change_list('/ocean_mod/namelists/' // trim(path_name))) then !{
2713  call mpp_error(fatal, trim(error_header) // ' Could not change to the namelist ' // trim(path_name))
2714 endif !}
2715 
2716 return
2717 
2718 end subroutine fm_util_start_namelist !}
2719 
2720 !#######################################################################
2721 
2722 !> Finish up processing a namelist
2723 subroutine fm_util_end_namelist(path, name, caller, check) !{
2724 
2725 implicit none
2726 
2727 !
2728 ! arguments
2729 !
2730 
2731 character(len=*), intent(in) :: path
2732 character(len=*), intent(in) :: name
2733 character(len=*), intent(in), optional :: caller
2734 logical, intent(in), optional :: check
2735 
2736 !
2737 ! Local parameters
2738 !
2739 
2740 character(len=48), parameter :: sub_name = 'fm_util_end_namelist'
2741 
2742 !
2743 ! Local variables
2744 !
2745 
2746 character(len=fm_string_len), pointer, dimension(:) :: good_list => null()
2747 character(len=FMS_PATH_LEN) :: path_name
2748 character(len=256) :: error_header
2749 character(len=256) :: warn_header
2750 character(len=256) :: note_header
2751 character(len=128) :: caller_str
2752 
2753 !
2754 ! set the caller string and headers
2755 !
2756 
2757 if (present(caller)) then !{
2758  caller_str = '[' // trim(caller) // ']'
2759 else !}{
2760  caller_str = fm_util_default_caller
2761 endif !}
2762 
2763 error_header = '==>Error from ' // trim(mod_name) // &
2764  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2765 warn_header = '==>Warning from ' // trim(mod_name) // &
2766  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2767 note_header = '==>Note from ' // trim(mod_name) // &
2768  '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
2769 
2770 !
2771 ! check that a path is given (fatal if not)
2772 !
2773 
2774 if (name .eq. ' ') then !{
2775  call mpp_error(fatal, trim(error_header) // ' Empty name given')
2776 endif !}
2777 
2778 !
2779 ! Check that the path ane name match the preceding call to
2780 ! fm_util_start_namelist
2781 !
2782 
2783 if (path .ne. save_path) then !{
2784  call mpp_error(fatal, trim(error_header) // &
2785  & ' Path "' // trim(path) // '" does not match saved path "' // trim(save_path) // '"')
2786 elseif (name .ne. save_name) then !}{
2787  call mpp_error(fatal, trim(error_header) // &
2788  & ' Name "' // trim(name) // '" does not match saved name "' // trim(save_name) // '"')
2789 endif !}
2790 
2791 !
2792 ! Concatenate the path and name
2793 !
2794 
2795 if (path .eq. ' ') then !{
2796  path_name = name
2797 else !}{
2798  path_name = trim(path) // '/' // name
2799 endif !}
2800 save_path = ' '
2801 save_name = ' '
2802 
2803 !
2804 ! Check for any errors in the number of fields in this list
2805 !
2806 
2807 if (present(check)) then !{
2808  if (check) then !{
2809  if (caller_str .eq. ' ') then !{
2810  caller_str = trim(mod_name) // '(' // trim(sub_name) // ')'
2811  endif !}
2812  good_list => fm_util_get_string_array('/ocean_mod/GOOD/namelists/' // trim(path_name) // '/good_list', &
2813  caller = trim(mod_name) // '(' // trim(sub_name) // ')')
2814  if (associated(good_list)) then !{
2815  call fm_util_check_for_bad_fields('/ocean_mod/namelists/' // trim(path_name), good_list, caller = caller_str)
2816  deallocate(good_list)
2817  else !}{
2818  call mpp_error(fatal, trim(error_header) // ' Empty "' // trim(path_name) // '" list')
2819  endif !}
2820  endif !}
2821 endif !}
2822 
2823 !
2824 ! Change back to the saved list
2825 !
2826 
2827 if (save_current_list .ne. ' ') then !{
2828  if (.not. fm_change_list(save_current_list)) then !{
2829  call mpp_error(fatal, trim(error_header) // ' Could not change to the saved list: ' // trim(save_current_list))
2830  endif !}
2831 endif !}
2832 save_current_list = ' '
2833 
2834 !
2835 ! reset the default caller string
2836 !
2837 
2838 call fm_util_reset_caller
2839 
2840 !
2841 ! reset the default no_overwrite string
2842 !
2843 
2844 call fm_util_reset_no_overwrite
2845 
2846 !
2847 ! reset the default good_name_list string
2848 !
2849 
2850 call fm_util_reset_good_name_list
2851 
2852 return
2853 
2854 end subroutine fm_util_end_namelist !}
2855 
2856 #include "fm_util_r4.fh"
2857 #include "fm_util_r8.fh"
2858 
2859 end module fm_util_mod !}
2860 !> @}
2861 ! close documentation grouping
field_manager_mod::fm_string_len
integer, parameter, public fm_string_len
The length of a character string representing character values for the field.
Definition: field_manager.F90:249
field_manager_mod::fm_get_length
integer function, public fm_get_length(name)
A function to return how many elements are contained within the named list or entry.
Definition: field_manager.F90:2217
field_manager_mod::fm_get_type
character(len=8) function, public fm_get_type(name)
A function to return the type of the named field.
Definition: field_manager.F90:2258
field_manager_mod::fm_exists
logical function, public fm_exists(name)
A function to test whether a named field exists.
Definition: field_manager.F90:2116
field_manager_mod::fm_change_list
logical function, public fm_change_list(name)
Change the current list. Return true on success, false otherwise.
Definition: field_manager.F90:1989
field_manager_mod::fm_new_list
integer function, public fm_new_list(name, create, keep)
A function to create a new list.
Definition: field_manager.F90:2576
field_manager_mod::fm_get_current_list
character(len=fms_path_len) function, public fm_get_current_list()
A function to return the full path of the current list.
Definition: field_manager.F90:2173
field_manager_mod::fm_get_index
integer function, public fm_get_index(name)
A function to return the index of a named field.
Definition: field_manager.F90:2139
field_manager_mod::fm_field_name_len
integer, parameter, public fm_field_name_len
The length of a character string representing the field name.
Definition: field_manager.F90:247
field_manager_mod::fm_type_name_len
integer, parameter, public fm_type_name_len
The length of a character string representing the various types that the values of the field can take...
Definition: field_manager.F90:251
field_manager_mod::fm_dump_list
logical function, public fm_dump_list(name, recursive, unit)
A function to list properties associated with a field.
Definition: field_manager.F90:2071
field_manager_mod::fm_get_value
An overloaded function to find and extract a value for a named field.
Definition: field_manager.F90:398
field_manager_mod::fm_loop_over_list
A function for looping over a list.
Definition: field_manager.F90:415
field_manager_mod::fm_new_value
An overloaded function to assign a value to a field.
Definition: field_manager.F90:379
fm_util_mod::fm_util_set_value_logical_array
subroutine fm_util_set_value_logical_array(name, lval, length, caller, no_overwrite, good_name_list)
Set a logical array in the Field Manager tree.
Definition: fm_util.F90:1730
fm_util_mod::fm_util_set_value_logical
subroutine fm_util_set_value_logical(name, lval, caller, index, append, no_create, no_overwrite, good_name_list)
Set a logical value in the Field Manager tree.
Definition: fm_util.F90:2217
fm_util_mod::fm_util_reset_no_overwrite
subroutine, public fm_util_reset_no_overwrite
Reset the default value for the optional "no_overwrite" variable used in some of these subroutines to...
Definition: fm_util.F90:297
fm_util_mod::fm_util_start_namelist
subroutine, public fm_util_start_namelist(path, name, caller, no_overwrite, check)
Start processing a namelist.
Definition: fm_util.F90:2559
fm_util_mod::fm_util_set_value_integer_array
subroutine fm_util_set_value_integer_array(name, ival, length, caller, no_overwrite, good_name_list)
Set an integer array in the Field Manager tree.
Definition: fm_util.F90:1573
fm_util_mod::fm_util_set_no_overwrite
subroutine, public fm_util_set_no_overwrite(no_overwrite)
Set the default value for the optional "no_overwrite" variable used in some of these subroutines.
Definition: fm_util.F90:263
fm_util_mod::fm_util_get_logical_array
logical function, dimension(:), pointer, public fm_util_get_logical_array(name, caller)
Get a logical value from the Field Manager tree.
Definition: fm_util.F90:836
fm_util_mod::fm_util_end_namelist
subroutine, public fm_util_end_namelist(path, name, caller, check)
Finish up processing a namelist.
Definition: fm_util.F90:2724
fm_util_mod::fm_util_check_for_bad_fields
subroutine, public fm_util_check_for_bad_fields(list, good_fields, caller)
Check for unrecognized fields in a list.
Definition: fm_util.F90:323
fm_util_mod::fm_util_get_index_list
integer function, public fm_util_get_index_list(name, caller)
Get the length of an element of the Field Manager tree.
Definition: fm_util.F90:659
fm_util_mod::fm_util_get_length
integer function, public fm_util_get_length(name, caller)
Get the length of an element of the Field Manager tree.
Definition: fm_util.F90:481
fm_util_mod::fm_util_set_value_string_array
subroutine fm_util_set_value_string_array(name, sval, length, caller, no_overwrite, good_name_list)
Set a string array in the Field Manager tree.
Definition: fm_util.F90:1887
fm_util_mod::fm_util_get_logical
logical function, public fm_util_get_logical(name, caller, index, default_value, scalar)
Get a logical value from the Field Manager tree.
Definition: fm_util.F90:1226
fm_util_mod::fm_util_set_caller
subroutine, public fm_util_set_caller(caller)
Set the default value for the optional "caller" variable used in many of these subroutines....
Definition: fm_util.F90:137
fm_util_mod::fm_util_reset_caller
subroutine, public fm_util_reset_caller
Reset the default value for the optional "caller" variable used in many of these subroutines to blank...
Definition: fm_util.F90:175
fm_util_mod::fm_util_get_integer_array
integer function, dimension(:), pointer, public fm_util_get_integer_array(name, caller)
Get an integer value from the Field Manager tree.
Definition: fm_util.F90:744
fm_util_mod::fm_util_reset_good_name_list
subroutine, public fm_util_reset_good_name_list
Reset the default value for the optional "good_name_list" variable used in many of these subroutines ...
Definition: fm_util.F90:236
fm_util_mod::fm_util_set_value_string
subroutine fm_util_set_value_string(name, sval, caller, index, append, no_create, no_overwrite, good_name_list)
Set a string value in the Field Manager tree.
Definition: fm_util.F90:2388
fm_util_mod::fm_util_get_real
real(r8_kind) function, public fm_util_get_real(name, caller, index, default_value, scalar)
Get a real value from the Field Manager tree.
Definition: fm_util.F90:1340
fm_util_mod::fm_util_get_integer
integer function, public fm_util_get_integer(name, caller, index, default_value, scalar)
Get an integer value from the Field Manager tree.
Definition: fm_util.F90:1113
fm_util_mod::fm_util_get_string_array
character(len=fm_string_len) function, dimension(:), pointer, public fm_util_get_string_array(name, caller)
Get a string value from the Field Manager tree.
Definition: fm_util.F90:1021
fm_util_mod::fm_util_set_value_integer
subroutine fm_util_set_value_integer(name, ival, caller, index, append, no_create, no_overwrite, good_name_list)
Set an integer value in the Field Manager tree.
Definition: fm_util.F90:2045
fm_util_mod::fm_util_get_index_string
integer function, public fm_util_get_index_string(name, string, caller)
Get the index of an element of a string in the Field Manager tree.
Definition: fm_util.F90:555
fm_util_mod::fm_util_set_good_name_list
subroutine, public fm_util_set_good_name_list(good_name_list)
Set the default value for the optional "good_name_list" variable used in many of these subroutines.
Definition: fm_util.F90:202
fm_util_mod::fm_util_get_real_array
real(r8_kind) function, dimension(:), pointer, public fm_util_get_real_array(name, caller)
Get a real value from the Field Manager tree.
Definition: fm_util.F90:928
fm_util_mod::fm_util_get_string
character(len=fm_string_len) function, public fm_util_get_string(name, caller, index, default_value, scalar)
Get a string value from the Field Manager tree.
Definition: fm_util.F90:1461
fm_util_mod::fm_util_set_value
Definition: fm_util.F90:110
stdout
integer function stdout()
This function returns the current standard fortran unit numbers for output.
Definition: mpp_util.inc:42
mpp_mod::mpp_error
Error handler.
Definition: mpp.F90:381
fm_util_mod::fm_util_set_value_real_array
Definition: fm_util.F90:104
fm_util_mod::fm_util_set_value_real
Definition: fm_util.F90:99