40 module atmos_ocean_fluxes_mod
56 use fm_util_mod,
only: fm_util_default_caller
66 use platform_mod,
only: r4_kind, r8_kind, fms_path_len
75 character(len=*),
parameter :: mod_name =
'atmos_ocean_fluxes_mod'
76 real(r8_kind),
parameter :: epsln=1.0e-30_r8_kind
80 #include<file_version.h>
115 & mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity) &
116 & result(coupler_index)
117 character(len=*),
intent(in) :: name
118 character(len=*),
intent(in) :: flux_type
119 character(len=*),
intent(in) :: implementation
120 integer,
intent(in),
optional :: atm_tr_index
121 class(*),
intent(in),
dimension(:),
optional :: param
122 logical,
intent(in),
dimension(:),
optional :: flag
123 class(*),
intent(in),
optional :: mol_wt
124 character(len=*),
intent(in),
optional :: ice_restart_file
125 character(len=*),
intent(in),
optional :: ocean_restart_file
126 character(len=*),
intent(in),
optional :: units
127 character(len=*),
intent(in),
optional :: caller
128 integer,
intent(in),
optional :: verbosity
130 integer :: coupler_index
132 character(len=*),
parameter :: sub_name =
'aof_set_coupler_flux'
136 integer :: num_parameters
138 character(len=FMS_PATH_LEN) :: coupler_list
139 character(len=FMS_PATH_LEN) :: current_list
140 character(len=fm_string_len) :: flux_type_test
141 character(len=fm_string_len) :: implementation_test
142 character(len=256) :: error_header
143 character(len=256) :: warn_header
144 character(len=256) :: note_header
145 character(len=128) :: flux_list
146 character(len=128) :: caller_str
147 character(len=fm_string_len),
pointer,
dimension(:) :: good_list => null()
148 character(len=256) :: long_err_msg
150 character(len=17) :: err_str
153 if (
present(verbosity)) verbose = verbosity
156 if (
present(caller))
then
157 caller_str =
'[' // trim(caller) //
']'
159 caller_str = fm_util_default_caller
162 error_header =
'==>Error from ' // trim(mod_name) //&
163 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':'
164 warn_header =
'==>Warning from ' // trim(mod_name) //&
165 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':'
166 note_header =
'==>Note from ' // trim(mod_name) //&
167 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':'
170 if (name .eq.
' ')
then
171 call mpp_error(fatal, trim(error_header) //
' Empty name given')
174 if (verbose >= 5)
then
176 write (outunit,*) trim(note_header),
' Processing coupler fluxes ', trim(name)
180 coupler_list =
'/coupler_mod/fluxes/' // trim(name)
186 if (fm_exists(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list'))
then
187 if (verbose >= 5)
then
189 write (outunit,*) trim(note_header),
' Using previously defined coupler flux'
191 coupler_index = fm_get_index(coupler_list)
192 if (coupler_index .le. 0)
then
193 call mpp_error(fatal, trim(error_header) //
' Could not get coupler flux ')
200 if (
present(atm_tr_index))
then
202 write (outunit,*) trim(note_header),
' Redefining atm_tr_index to ', atm_tr_index
204 & no_create = .true., no_overwrite = .false., caller = caller_str)
210 coupler_index = fm_new_list(coupler_list)
211 if (coupler_index .le. 0)
then
212 call mpp_error(fatal, trim(error_header) //
' Could not set coupler flux ')
216 current_list = fm_get_current_list()
217 if (current_list .eq.
' ')
then
218 call mpp_error(fatal, trim(error_header) //
' Could not get the current list')
221 if (.not. fm_change_list(coupler_list))
then
222 call mpp_error(fatal, trim(error_header) //
' Could not change to the new list')
228 call fm_util_set_good_name_list(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list')
231 call fm_util_set_no_overwrite(.true.)
232 call fm_util_set_caller(caller_str)
235 if (flux_type .eq.
' ')
then
236 call mpp_error(fatal, trim(error_header) //
' Blank flux_type given')
238 if (fm_exists(
'/coupler_mod/types/' // trim(flux_type)))
then
243 flux_type_test = fm_util_get_string(
'flux_type', scalar = .true.)
244 if (.not. fm_exists(
'/coupler_mod/types/' // trim(flux_type_test)))
then
245 call mpp_error(fatal, trim(error_header) //&
246 &
' Undefined flux_type given from field_table: ' // trim(flux_type_test))
249 call mpp_error(fatal, trim(error_header) //&
250 &
' Undefined flux_type given as argument to the subroutine: ' // trim(flux_type))
254 if (implementation .eq.
' ')
then
255 call mpp_error(fatal, trim(error_header) //
' Blank flux_type given')
257 if (fm_exists(
'/coupler_mod/types/' // trim(flux_type) //
'/implementation/' // trim(implementation)))
then
262 implementation_test = fm_util_get_string(
'implementation', scalar = .true.)
263 if (.not. fm_exists(
'/coupler_mod/types/' // trim(flux_type_test) //
'/implementation/' // &
264 & trim(implementation_test)))
then
265 if (flux_type .eq. flux_type_test)
then
266 if (implementation .eq. implementation_test)
then
267 call mpp_error(fatal, trim(error_header) //
' Should not get here, as it is tested for above')
269 call mpp_error(fatal, trim(error_header) //&
270 &
' Undefined flux_type/implementation (implementation given from field_table): ' //&
271 & trim(flux_type_test) //
'/implementation/' // trim(implementation_test))
274 if (implementation .eq. implementation_test)
then
275 long_err_msg =
'Undefined flux_type/implementation (flux_type given from field_table): '
276 long_err_msg = long_err_msg // trim(flux_type_test) //
'/implementation/'&
277 & // trim(implementation_test)
278 call mpp_error(fatal, trim(error_header) // long_err_msg)
280 long_err_msg =
' Undefined flux_type/implementation (both given from field_table): '
281 long_err_msg = long_err_msg // trim(flux_type_test) //
'/implementation/'&
282 & // trim(implementation_test)
283 call mpp_error(fatal, trim(error_header) // long_err_msg)
288 call mpp_error(fatal, trim(error_header) //&
289 &
' Undefined flux_type/implementation given as argument to the subroutine: ' //&
290 & trim(flux_type) //
'/implementation/' // trim(implementation))
294 if (
present(atm_tr_index))
then
300 if (
present(mol_wt))
then
303 type is (real(r8_kind))
305 type is (real(r4_kind))
309 call mpp_error(fatal,
"aof_set_coupler_flux: invalid type for passed in mol_wt, type should be" // &
310 "real(r4_kind) or real(r8_kind). Passed in type:"//err_str)
316 if (
present(ice_restart_file))
then
322 if (
present(ocean_restart_file))
then
328 if (
present(param))
then
329 num_parameters = fm_util_get_integer(
'/coupler_mod/types/' //&
330 & trim(fm_util_get_string(
'flux_type', scalar = .true.)) //
'/implementation/' //&
331 & trim(fm_util_get_string(
'implementation', scalar = .true.)) //
'/num_parameters',&
333 length = min(
size(param(:)),num_parameters)
334 if ((length .ne. num_parameters) .and. (verbose >= 5))
then
335 write (outunit,*) trim(note_header),
' Number of parameters provided for ', trim(name),
' does not match the'
336 write (outunit,*)
'number of parameters required (',
size(param(:)),
' != ', num_parameters,
').'
337 write (outunit,*)
'This could be an error, or more likely is just a result of the implementation being'
338 write (outunit,*)
'overridden by the field table input'
340 if (length .gt. 0)
then
342 type is (real(r4_kind))
344 type is (real(r8_kind))
348 call mpp_error(fatal,
"aof_set_coupler_flux: invalid type for passed in param, type should be" // &
349 "real(r4_kind) or real(r8_kind). Passed in type:"//err_str)
358 if (
present(flag))
then
364 flux_list =
'/coupler_mod/types/' // trim(flux_type) //
'/'
366 if (
present(units))
then
371 & fm_util_get_string(trim(flux_list) //
'flux/units', index =
ind_flux))
374 do n = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
376 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = n)) //
'-units',&
377 & fm_util_get_string(trim(flux_list) //
'flux/units', index = n))
379 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = n)) //
'-long_name',&
380 & fm_util_get_string(trim(flux_list) //
'flux/long_name', index = n))
383 do n = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
384 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = n)) //&
385 &
'-units', fm_util_get_string(trim(flux_list) //
'atm/units', index = n))
386 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = n)) //
'-long_name',&
387 & fm_util_get_string(trim(flux_list) //
'atm/long_name', index = n))
390 do n = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
391 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = n)) //
'-units',&
392 & fm_util_get_string(trim(flux_list) //
'ice/units', index = n))
393 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = n)) //
'-long_name',&
394 & fm_util_get_string(trim(flux_list) //
'ice/long_name', index = n))
398 call fm_util_reset_good_name_list
399 call fm_util_reset_no_overwrite
400 call fm_util_reset_caller
403 if (.not. fm_change_list(current_list))
then
404 call mpp_error(fatal, trim(error_header) //
' Could not change back to ' // trim(current_list))
408 if (caller_str .eq.
' ')
then
409 caller_str = trim(mod_name) //
'(' // trim(sub_name) //
')'
411 good_list => fm_util_get_string_array(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list',&
412 & caller = caller_str)
413 if (
associated(good_list))
then
414 call fm_util_check_for_bad_fields(trim(coupler_list), good_list, caller = caller_str)
415 deallocate(good_list)
417 call mpp_error(fatal, trim(error_header) //
' Empty "' // trim(name) //
'" list')
465 integer,
optional,
intent(in) :: verbosity
466 logical,
optional,
intent(in) :: use_r4_kind
468 logical :: use_r4_kind_loc = .false.
470 character(len=*),
parameter :: sub_name =
'atmos_ocean_fluxes_init'
471 character(len=*),
parameter :: error_header =&
472 &
'==>Error from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):'
473 character(len=*),
parameter :: warn_header =&
474 &
'==>Warning from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):'
475 character(len=*),
parameter :: note_header =&
476 &
'==>Note from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):'
478 integer :: num_parameters
482 character(len=128) :: caller_str
483 character(len=fm_type_name_len) :: typ
484 character(len=fm_field_name_len) :: name
487 integer :: total_fluxes
488 character(len=8) :: string
489 character(len=128) :: error_string
490 character(len=128) :: flux_list
491 logical,
save :: initialized = .false.
494 if (initialized)
return
497 if (
present(verbosity)) verbose = verbosity
508 if (verbose >= 9)
then
510 write (outunit,*)
'Dumping field manager tree'
511 if (.not. fm_dump_list(
'/',
recursive = .true.)) &
512 call mpp_error(fatal, trim(error_header) //
' Problem dumping field manager tree')
515 caller_str = trim(mod_name) //
'(' // trim(sub_name) //
')'
518 call fm_util_set_no_overwrite(.true.)
519 call fm_util_set_caller(caller_str)
522 gas_fluxes%num_bcs = fm_util_get_length(
'/coupler_mod/fluxes/')
523 gas_fluxes%set = .true.
524 gas_fields_atm%num_bcs = gas_fluxes%num_bcs ; gas_fields_atm%set = .true.
525 gas_fields_ice%num_bcs = gas_fluxes%num_bcs ; gas_fields_ice%set = .true.
526 if (gas_fluxes%num_bcs .lt. 0)
then
527 call mpp_error(fatal, trim(error_header) //
' Could not get number of fluxes')
528 elseif (gas_fluxes%num_bcs .eq. 0)
then
530 write (outunit,*) trim(note_header),
' No gas fluxes'
534 write (outunit,*) trim(note_header),
' Processing ', gas_fluxes%num_bcs,
' gas fluxes'
537 if(
present(use_r4_kind)) use_r4_kind_loc = use_r4_kind
540 if( .not. use_r4_kind_loc)
then
541 allocate (gas_fluxes%bc(gas_fluxes%num_bcs))
542 allocate (gas_fields_atm%bc(gas_fields_atm%num_bcs))
543 allocate (gas_fields_ice%bc(gas_fields_ice%num_bcs))
545 allocate (gas_fluxes%bc_r4(gas_fluxes%num_bcs))
546 allocate (gas_fields_atm%bc_r4(gas_fields_atm%num_bcs))
547 allocate (gas_fields_ice%bc_r4(gas_fields_ice%num_bcs))
553 if (typ .ne.
'list')
then
554 call mpp_error(fatal, trim(error_header) //
' ' // trim(name) //
' is not a list')
561 write (outunit,*) trim(warn_header),
' Flux index, ', ind,&
562 &
' does not match array index, ', n,
' for ', trim(name)
566 if (.not. fm_change_list(
'/coupler_mod/fluxes/' // trim(name)))
then
567 call mpp_error(fatal, trim(error_header) //
' Problem changing to ' // trim(name))
572 if (.not.use_r4_kind_loc)
then
574 gas_fluxes%bc(n)%flux_type = fm_util_get_string(
'flux_type', scalar = .true.)
575 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type)))
then
576 call mpp_error(fatal, trim(error_header) //
' Undefined flux_type given for ' //&
577 & trim(name) //
': ' // trim(gas_fluxes%bc(n)%flux_type))
579 gas_fields_atm%bc(n)%flux_type = gas_fluxes%bc(n)%flux_type
580 gas_fields_ice%bc(n)%flux_type = gas_fluxes%bc(n)%flux_type
583 gas_fluxes%bc(n)%implementation = fm_util_get_string(
'implementation', scalar = .true.)
584 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type) //&
585 &
'/implementation/' // trim(gas_fluxes%bc(n)%implementation)))
then
586 call mpp_error(fatal, trim(error_header) //
' Undefined implementation given for ' //&
587 & trim(name) //
': ' // trim(gas_fluxes%bc(n)%flux_type) //
'/implementation/' //&
588 & trim(gas_fluxes%bc(n)%implementation))
590 gas_fields_atm%bc(n)%implementation = gas_fluxes%bc(n)%implementation
591 gas_fields_ice%bc(n)%implementation = gas_fluxes%bc(n)%implementation
594 flux_list =
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type) //
'/'
597 gas_fluxes%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'flux/name')
598 allocate (gas_fluxes%bc(n)%field(gas_fluxes%bc(n)%num_fields))
599 gas_fields_atm%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'atm/name')
600 allocate (gas_fields_atm%bc(n)%field(gas_fields_atm%bc(n)%num_fields))
601 gas_fields_ice%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'ice/name')
602 allocate (gas_fields_ice%bc(n)%field(gas_fields_ice%bc(n)%num_fields))
605 gas_fluxes%bc(n)%name = name
606 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
607 gas_fluxes%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
608 &
'flux/name', index = m)
609 gas_fluxes%bc(n)%field(m)%override = .false.
610 gas_fluxes%bc(n)%field(m)%mean = .false.
613 gas_fields_atm%bc(n)%name = name
614 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
615 gas_fields_atm%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
616 &
'atm/name', index = m)
617 gas_fields_atm%bc(n)%field(m)%override = .false.
618 gas_fields_atm%bc(n)%field(m)%mean = .false.
621 gas_fields_ice%bc(n)%name = name
622 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
623 gas_fields_ice%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) // &
624 &
'ice/name', index = m)
625 gas_fields_ice%bc(n)%field(m)%override = .false.
626 gas_fields_ice%bc(n)%field(m)%mean = .false.
630 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
631 gas_fluxes%bc(n)%field(m)%units =&
632 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) // &
633 &
'-units', scalar = .true.)
635 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
636 gas_fields_atm%bc(n)%field(m)%units =&
637 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-units')
639 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
640 gas_fields_ice%bc(n)%field(m)%units =&
641 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-units')
645 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
646 gas_fluxes%bc(n)%field(m)%long_name =&
647 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) // &
648 &
'-long_name', scalar = .true.)
649 gas_fluxes%bc(n)%field(m)%long_name = trim(gas_fluxes%bc(n)%field(m)%long_name) //
' for ' // name
651 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
652 gas_fields_atm%bc(n)%field(m)%long_name =&
653 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-long_name')
654 gas_fields_atm%bc(n)%field(m)%long_name = trim(gas_fields_atm%bc(n)%field(m)%long_name) //
' for ' // name
656 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
657 gas_fields_ice%bc(n)%field(m)%long_name =&
658 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-long_name')
659 gas_fields_ice%bc(n)%field(m)%long_name = trim(gas_fields_ice%bc(n)%field(m)%long_name) //
' for ' // name
663 gas_fluxes%bc(n)%atm_tr_index = fm_util_get_integer(
'atm_tr_index', scalar = .true.)
666 gas_fluxes%bc(n)%mol_wt = fm_util_get_real(
'mol_wt', scalar = .true.)
667 gas_fields_atm%bc(n)%mol_wt = gas_fluxes%bc(n)%mol_wt
668 gas_fields_ice%bc(n)%mol_wt = gas_fluxes%bc(n)%mol_wt
671 gas_fluxes%bc(n)%ice_restart_file = fm_util_get_string(
'ice_restart_file', scalar = .true.)
672 gas_fields_atm%bc(n)%ice_restart_file = gas_fluxes%bc(n)%ice_restart_file
673 gas_fields_ice%bc(n)%ice_restart_file = gas_fluxes%bc(n)%ice_restart_file
676 gas_fluxes%bc(n)%ocean_restart_file = fm_util_get_string(
'ocean_restart_file', scalar = .true.)
677 gas_fields_atm%bc(n)%ocean_restart_file = gas_fluxes%bc(n)%ocean_restart_file
678 gas_fields_ice%bc(n)%ocean_restart_file = gas_fluxes%bc(n)%ocean_restart_file
681 gas_fluxes%bc(n)%param => fm_util_get_real_array(
'param')
687 num_parameters = fm_util_get_integer(trim(flux_list) //
'implementation/' //&
688 & trim(gas_fluxes%bc(n)%implementation) //
'/num_parameters', scalar = .true.)
689 if (num_parameters .gt. 0)
then
690 if (.not.
associated(gas_fluxes%bc(n)%param))
then
691 write (error_string,
'(a,i2)')
': need ', num_parameters
692 call mpp_error(fatal, trim(error_header) //
' No param for ' // trim(name) // trim(error_string))
693 elseif (
size(gas_fluxes%bc(n)%param(:)) .ne. num_parameters)
then
694 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc(n)%param(:)),
' given, need ', num_parameters
695 call mpp_error(fatal, trim(error_header) // &
696 &
' Wrong number of param for ' // trim(name) // trim(error_string))
698 elseif (num_parameters .eq. 0)
then
699 if (
associated(gas_fluxes%bc(n)%param))
then
700 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc(n)%param(:))
701 call mpp_error(fatal, trim(error_header) //
' No params needed for ' // trim(name) // trim(error_string))
704 write (error_string,
'(a,i2)')
': ', num_parameters
705 call mpp_error(fatal, trim(error_header) // &
706 &
'Num_parameters is negative for ' // trim(name) // trim(error_string))
708 num_flags = fm_util_get_integer(trim(flux_list) //
'/num_flags', scalar = .true.)
709 if (num_flags .gt. 0)
then
710 if (.not.
associated(gas_fluxes%bc(n)%flag))
then
711 write (error_string,
'(a,i2)')
': need ', num_flags
712 call mpp_error(fatal, trim(error_header) //
' No flag for ' // trim(name) // trim(error_string))
713 elseif (
size(gas_fluxes%bc(n)%flag(:)) .ne. num_flags)
then
714 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc(n)%flag(:)),
' given, need ', num_flags
715 call mpp_error(fatal, trim(error_header) //
' Wrong number of flag for ' // trim(name)//trim(error_string))
717 elseif (num_flags .eq. 0)
then
718 if (
associated(gas_fluxes%bc(n)%flag))
then
719 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc(n)%flag(:))
720 call mpp_error(fatal, trim(error_header) //
' No flags needed for ' // trim(name) // trim(error_string))
723 write (error_string,
'(a,i2)')
': ', num_flags
724 call mpp_error(fatal, trim(error_header) //
'Num_flags is negative for ' // trim(name) // trim(error_string))
728 gas_fluxes%bc(n)%use_atm_pressure =
fm_util_get_logical(trim(flux_list) //
'/use_atm_pressure')
729 gas_fields_atm%bc(n)%use_atm_pressure = gas_fluxes%bc(n)%use_atm_pressure
730 gas_fields_ice%bc(n)%use_atm_pressure = gas_fluxes%bc(n)%use_atm_pressure
732 gas_fluxes%bc(n)%use_10m_wind_speed =
fm_util_get_logical(trim(flux_list) //
'/use_10m_wind_speed')
733 gas_fields_atm%bc(n)%use_10m_wind_speed = gas_fluxes%bc(n)%use_10m_wind_speed
734 gas_fields_ice%bc(n)%use_10m_wind_speed = gas_fluxes%bc(n)%use_10m_wind_speed
736 gas_fluxes%bc(n)%pass_through_ice =
fm_util_get_logical(trim(flux_list) //
'/pass_through_ice')
737 gas_fields_atm%bc(n)%pass_through_ice = gas_fluxes%bc(n)%pass_through_ice
738 gas_fields_ice%bc(n)%pass_through_ice = gas_fluxes%bc(n)%pass_through_ice
743 gas_fluxes%bc_r4(n)%flux_type = fm_util_get_string(
'flux_type', scalar = .true.)
744 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type)))
then
745 call mpp_error(fatal, trim(error_header) //
' Undefined flux_type given for ' //&
746 & trim(name) //
': ' // trim(gas_fluxes%bc_r4(n)%flux_type))
748 gas_fields_atm%bc_r4(n)%flux_type = gas_fluxes%bc_r4(n)%flux_type
749 gas_fields_ice%bc_r4(n)%flux_type = gas_fluxes%bc_r4(n)%flux_type
752 gas_fluxes%bc_r4(n)%implementation = fm_util_get_string(
'implementation', scalar = .true.)
753 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type) //&
754 &
'/implementation/' // trim(gas_fluxes%bc_r4(n)%implementation)))
then
755 call mpp_error(fatal, trim(error_header) //
' Undefined implementation given for ' //&
756 & trim(name) //
': ' // trim(gas_fluxes%bc_r4(n)%flux_type) //
'/implementation/' //&
757 & trim(gas_fluxes%bc_r4(n)%implementation))
759 gas_fields_atm%bc_r4(n)%implementation = gas_fluxes%bc_r4(n)%implementation
760 gas_fields_ice%bc_r4(n)%implementation = gas_fluxes%bc_r4(n)%implementation
763 flux_list =
'/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type) //
'/'
766 gas_fluxes%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) //
'flux/name')
767 allocate (gas_fluxes%bc_r4(n)%field(gas_fluxes%bc_r4(n)%num_fields))
768 gas_fields_atm%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) //
'atm/name')
769 allocate (gas_fields_atm%bc_r4(n)%field(gas_fields_atm%bc_r4(n)%num_fields))
770 gas_fields_ice%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) //
'ice/name')
771 allocate (gas_fields_ice%bc_r4(n)%field(gas_fields_ice%bc_r4(n)%num_fields))
774 gas_fluxes%bc_r4(n)%name = name
775 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
776 gas_fluxes%bc_r4(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
777 &
'flux/name', index = m)
778 gas_fluxes%bc_r4(n)%field(m)%override = .false.
779 gas_fluxes%bc_r4(n)%field(m)%mean = .false.
782 gas_fields_atm%bc_r4(n)%name = name
783 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
784 gas_fields_atm%bc_r4(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
785 &
'atm/name', index = m)
786 gas_fields_atm%bc_r4(n)%field(m)%override = .false.
787 gas_fields_atm%bc_r4(n)%field(m)%mean = .false.
790 gas_fields_ice%bc_r4(n)%name = name
791 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
792 gas_fields_ice%bc_r4(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) // &
793 &
'ice/name', index = m)
794 gas_fields_ice%bc_r4(n)%field(m)%override = .false.
795 gas_fields_ice%bc_r4(n)%field(m)%mean = .false.
799 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
800 gas_fluxes%bc_r4(n)%field(m)%units =&
801 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) // &
802 &
'-units', scalar = .true.)
804 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
805 gas_fields_atm%bc_r4(n)%field(m)%units =&
806 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-units')
808 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
809 gas_fields_ice%bc_r4(n)%field(m)%units =&
810 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-units')
814 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
815 gas_fluxes%bc_r4(n)%field(m)%long_name =&
816 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) // &
817 &
'-long_name', scalar = .true.)
818 gas_fluxes%bc_r4(n)%field(m)%long_name = trim(gas_fluxes%bc_r4(n)%field(m)%long_name) //
' for ' // name
820 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
821 gas_fields_atm%bc_r4(n)%field(m)%long_name =&
822 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-long_name')
823 gas_fields_atm%bc_r4(n)%field(m)%long_name = trim(gas_fields_atm%bc_r4(n)%field(m)%long_name)// &
826 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
827 gas_fields_ice%bc_r4(n)%field(m)%long_name =&
828 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-long_name')
829 gas_fields_ice%bc_r4(n)%field(m)%long_name = trim(gas_fields_ice%bc_r4(n)%field(m)%long_name) // &
834 gas_fluxes%bc_r4(n)%atm_tr_index = fm_util_get_integer(
'atm_tr_index', scalar = .true.)
837 gas_fluxes%bc_r4(n)%mol_wt = fm_util_get_real(
'mol_wt', scalar = .true.)
838 gas_fields_atm%bc_r4(n)%mol_wt = gas_fluxes%bc_r4(n)%mol_wt
839 gas_fields_ice%bc_r4(n)%mol_wt = gas_fluxes%bc_r4(n)%mol_wt
842 gas_fluxes%bc_r4(n)%ice_restart_file = fm_util_get_string(
'ice_restart_file', scalar = .true.)
843 gas_fields_atm%bc_r4(n)%ice_restart_file = gas_fluxes%bc_r4(n)%ice_restart_file
844 gas_fields_ice%bc_r4(n)%ice_restart_file = gas_fluxes%bc_r4(n)%ice_restart_file
847 gas_fluxes%bc_r4(n)%ocean_restart_file = fm_util_get_string(
'ocean_restart_file', scalar = .true.)
848 gas_fields_atm%bc_r4(n)%ocean_restart_file = gas_fluxes%bc_r4(n)%ocean_restart_file
849 gas_fields_ice%bc_r4(n)%ocean_restart_file = gas_fluxes%bc_r4(n)%ocean_restart_file
852 gas_fluxes%bc_r4(n)%param => fm_util_get_real_array(
'param')
858 num_parameters = fm_util_get_integer(trim(flux_list) //
'implementation/' //&
859 & trim(gas_fluxes%bc_r4(n)%implementation) //
'/num_parameters', scalar = .true.)
860 if (num_parameters .gt. 0)
then
861 if (.not.
associated(gas_fluxes%bc_r4(n)%param))
then
862 write (error_string,
'(a,i2)')
': need ', num_parameters
863 call mpp_error(fatal, trim(error_header) //
' No param for ' // trim(name) // trim(error_string))
864 elseif (
size(gas_fluxes%bc_r4(n)%param(:)) .ne. num_parameters)
then
865 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc_r4(n)%param(:)),
' given, need ', num_parameters
866 call mpp_error(fatal, trim(error_header) // &
867 &
' Wrong number of param for ' // trim(name) // trim(error_string))
869 elseif (num_parameters .eq. 0)
then
870 if (
associated(gas_fluxes%bc_r4(n)%param))
then
871 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc_r4(n)%param(:))
872 call mpp_error(fatal, trim(error_header) //
' No params needed for ' // trim(name) // trim(error_string))
875 write (error_string,
'(a,i2)')
': ', num_parameters
876 call mpp_error(fatal, trim(error_header) // &
877 &
'Num_parameters is negative for ' // trim(name) // trim(error_string))
879 num_flags = fm_util_get_integer(trim(flux_list) //
'/num_flags', scalar = .true.)
880 if (num_flags .gt. 0)
then
881 if (.not.
associated(gas_fluxes%bc_r4(n)%flag))
then
882 write (error_string,
'(a,i2)')
': need ', num_flags
883 call mpp_error(fatal, trim(error_header) //
' No flag for ' // trim(name) // trim(error_string))
884 elseif (
size(gas_fluxes%bc_r4(n)%flag(:)) .ne. num_flags)
then
885 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc_r4(n)%flag(:)),
' given, need ', num_flags
886 call mpp_error(fatal, trim(error_header) //
' Wrong number of flag for '//trim(name)//trim(error_string))
888 elseif (num_flags .eq. 0)
then
889 if (
associated(gas_fluxes%bc_r4(n)%flag))
then
890 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc_r4(n)%flag(:))
891 call mpp_error(fatal, trim(error_header) //
' No flags needed for ' // trim(name) // trim(error_string))
894 write (error_string,
'(a,i2)')
': ', num_flags
895 call mpp_error(fatal, trim(error_header) //
'Num_flags is negative for ' // trim(name) // trim(error_string))
899 gas_fluxes%bc_r4(n)%use_atm_pressure =
fm_util_get_logical(trim(flux_list) //
'/use_atm_pressure')
900 gas_fields_atm%bc_r4(n)%use_atm_pressure = gas_fluxes%bc_r4(n)%use_atm_pressure
901 gas_fields_ice%bc_r4(n)%use_atm_pressure = gas_fluxes%bc_r4(n)%use_atm_pressure
903 gas_fluxes%bc_r4(n)%use_10m_wind_speed =
fm_util_get_logical(trim(flux_list) //
'/use_10m_wind_speed')
904 gas_fields_atm%bc_r4(n)%use_10m_wind_speed = gas_fluxes%bc_r4(n)%use_10m_wind_speed
905 gas_fields_ice%bc_r4(n)%use_10m_wind_speed = gas_fluxes%bc_r4(n)%use_10m_wind_speed
907 gas_fluxes%bc_r4(n)%pass_through_ice =
fm_util_get_logical(trim(flux_list) //
'/pass_through_ice')
908 gas_fields_atm%bc_r4(n)%pass_through_ice = gas_fluxes%bc_r4(n)%pass_through_ice
909 gas_fields_ice%bc_r4(n)%pass_through_ice = gas_fluxes%bc_r4(n)%pass_through_ice
913 if (verbose >= 5)
then
915 write (outunit,*)
'Dumping fluxes tracer tree'
916 if (.not. fm_dump_list(
'/coupler_mod/fluxes',
recursive = .true.))
then
917 call mpp_error(fatal, trim(error_header) //
' Problem dumping fluxes tracer tree')
924 total_fluxes = gas_fluxes%num_bcs
926 if (total_fluxes .ne.
mpp_npes() * gas_fluxes%num_bcs)
then
927 write (string,
'(i4)') gas_fluxes%num_bcs
928 call mpp_error(fatal, trim(error_header) //&
929 &
' Number of fluxes does not match across the processors: ' // trim(string) //
' fluxes')
933 call fm_util_reset_no_overwrite
934 call fm_util_reset_caller
1104 integer,
intent(in),
optional :: verbosity
1108 character(len=*),
parameter :: sub_name =
'atmos_ocean_type_fluxes_init'
1109 character(len=*),
parameter :: caller_str =&
1110 & trim(mod_name) //
'(' // trim(sub_name) //
')'
1111 character(len=*),
parameter :: error_header =&
1112 &
'==>Error from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):'
1113 logical,
save :: initialized = .false.
1115 if (initialized)
return
1118 if (
present(verbosity)) verbose = verbosity
1120 initialized = .true.
1122 call fm_util_set_no_overwrite(.true.)
1123 call fm_util_set_caller(caller_str)
1126 if (fm_new_list(
'/coupler_mod') .le. 0)
then
1127 call mpp_error(fatal, trim(error_header) //
' Could not set the "coupler_mod" list')
1130 if (fm_new_list(
'/coupler_mod/GOOD') .le. 0)
then
1131 call mpp_error(fatal, trim(error_header) //
' Could not set the "GOOD" list')
1133 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'GOOD', append = .true.)
1135 if (fm_new_list(
'/coupler_mod/fluxes') .le. 0)
then
1136 call mpp_error(fatal, trim(error_header) //
' Could not set the "/coupler_mod/fluxes" list')
1138 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'fluxes', append = .true.)
1140 if (fm_new_list(
'/coupler_mod/types') .le. 0)
then
1141 call mpp_error(fatal, trim(error_header) //
' Could not set the "/coupler_mod/types" list')
1143 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'types', append = .true.)
1146 if (.not. fm_change_list(
'/coupler_mod/types'))
then
1147 call mpp_error(fatal, trim(error_header) //
' Could not change to "/coupler_mod/types"')
1152 if (fm_new_list(
'air_sea_gas_flux_generic') .le. 0)
then
1153 call mpp_error(fatal, trim(error_header) //&
1154 &
' Could not set the "air_sea_gas_flux_generic" list')
1158 if (fm_new_list(
'air_sea_gas_flux_generic/implementation') .le. 0)
then
1159 call mpp_error(fatal, trim(error_header) //&
1160 &
' Could not set the "air_sea_gas_flux_generic/implementation" list')
1164 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/ocmip2') .le. 0)
then
1165 call mpp_error(fatal, trim(error_header) //&
1166 &
' Could not set the "air_sea_gas_flux_generic/implementation/ocmip2" list')
1168 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/ocmip2/num_parameters', 2)
1170 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/duce') .le. 0)
then
1171 call mpp_error(fatal, trim(error_header) //&
1172 &
' Could not set the "air_sea_gas_flux_generic/implementation/duce" list')
1174 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/duce/num_parameters', 1)
1176 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/johnson') .le. 0)
then
1177 call mpp_error(fatal, trim(error_header) // &
1178 &
' Could not set the "air_sea_gas_flux_generic/implementation/johnson" list')
1180 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/johnson/num_parameters', 2)
1189 if (fm_new_list(
'air_sea_gas_flux_generic/atm') .le. 0)
then
1190 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/atm" list')
1193 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'pcair', index = ind_pcair)
1194 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Atmospheric concentration', index = ind_pcair)
1195 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'mol/mol', index = ind_pcair)
1197 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'u10', index = ind_u10)
1198 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Wind speed at 10 m', index = ind_u10)
1199 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'm/s', index = ind_u10)
1201 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'psurf', index = ind_psurf)
1202 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Surface atmospheric pressure', index = ind_psurf)
1203 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'Pa', index = ind_psurf)
1206 if (fm_new_list(
'air_sea_gas_flux_generic/ice') .le. 0)
then
1207 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/ice" list')
1210 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'alpha', index = ind_alpha)
1211 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Solubility w.r.t. atmosphere', index = ind_alpha)
1212 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'mol/m^3/atm', index = ind_alpha)
1214 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'csurf', index = ind_csurf)
1215 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Ocean concentration', index = ind_csurf)
1216 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'mol/m^3', index = ind_csurf)
1218 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'sc_no', index = ind_sc_no)
1219 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Schmidt number', index = ind_sc_no)
1220 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'dimensionless', index = ind_sc_no)
1223 if (fm_new_list(
'air_sea_gas_flux_generic/flux') .le. 0)
then
1224 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/flux" list')
1244 if (fm_new_list(
'air_sea_gas_flux') .le. 0)
then
1245 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux" list')
1249 if (fm_new_list(
'air_sea_gas_flux/implementation') .le. 0)
then
1250 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation" list')
1254 if (fm_new_list(
'air_sea_gas_flux/implementation/ocmip2') .le. 0)
then
1255 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation/ocmip2" list')
1257 call fm_util_set_value(
'air_sea_gas_flux/implementation/ocmip2/num_parameters', 2)
1258 if (fm_new_list(
'air_sea_gas_flux/implementation/ocmip2_data') .le. 0)
then
1259 call mpp_error(fatal, trim(error_header) // &
1260 &
' Could not set the "air_sea_gas_flux/implementation/ocmip2_data" list')
1262 call fm_util_set_value(
'air_sea_gas_flux/implementation/ocmip2_data/num_parameters', 2)
1263 if (fm_new_list(
'air_sea_gas_flux/implementation/linear') .le. 0)
then
1264 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation/linear" list')
1266 call fm_util_set_value(
'air_sea_gas_flux/implementation/linear/num_parameters', 3)
1275 if (fm_new_list(
'air_sea_gas_flux/atm') .le. 0)
then
1276 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/atm" list')
1280 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Atmospheric concentration', index = ind_pcair)
1281 call fm_util_set_value(
'air_sea_gas_flux/atm/units',
'mol/mol', index = ind_pcair)
1284 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Wind speed at 10 m', index = ind_u10)
1288 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Surface atmospheric pressure', index = ind_psurf)
1292 if (fm_new_list(
'air_sea_gas_flux/ice') .le. 0)
then
1293 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/ice" list')
1298 &
'Solubility from atmosphere times Schmidt number term', index = ind_alpha)
1299 call fm_util_set_value(
'air_sea_gas_flux/ice/units',
'mol/m^3/atm', index = ind_alpha)
1302 call fm_util_set_value(
'air_sea_gas_flux/ice/long_name',
'Ocean concentration times Schmidt number term', &
1303 & index = ind_csurf)
1304 call fm_util_set_value(
'air_sea_gas_flux/ice/units',
'mol/m^3', index = ind_csurf)
1307 if (fm_new_list(
'air_sea_gas_flux/flux') .le. 0)
then
1308 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/flux" list')
1316 if (fm_new_list(
'air_sea_deposition') .le. 0)
then
1317 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition" list')
1321 if (fm_new_list(
'air_sea_deposition/implementation') .le. 0)
then
1322 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation" list')
1326 if (fm_new_list(
'air_sea_deposition/implementation/dry') .le. 0)
then
1327 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation/dry" list')
1329 call fm_util_set_value(
'air_sea_deposition/implementation/dry/num_parameters', 1)
1330 if (fm_new_list(
'air_sea_deposition/implementation/wet') .le. 0)
then
1331 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation/wet" list')
1333 call fm_util_set_value(
'air_sea_deposition/implementation/wet/num_parameters', 1)
1342 if (fm_new_list(
'air_sea_deposition/atm') .le. 0)
then
1343 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/atm" list')
1346 call fm_util_set_value(
'air_sea_deposition/atm/name',
'deposition', index = ind_deposition)
1347 call fm_util_set_value(
'air_sea_deposition/atm/long_name',
'Atmospheric deposition', index = ind_deposition)
1348 call fm_util_set_value(
'air_sea_deposition/atm/units',
'kg/m^2/s', index = ind_deposition)
1351 if (fm_new_list(
'air_sea_deposition/ice') .le. 0)
then
1352 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/ice" list')
1360 if (fm_new_list(
'air_sea_deposition/flux') .le. 0)
then
1361 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/flux" list')
1369 if (fm_new_list(
'land_sea_runoff') .le. 0)
then
1370 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff" list')
1374 if (fm_new_list(
'land_sea_runoff/implementation') .le. 0)
then
1375 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/implementation" list')
1379 if (fm_new_list(
'land_sea_runoff/implementation/river') .le. 0)
then
1380 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/implementation/river" list')
1382 call fm_util_set_value(
'land_sea_runoff/implementation/river/num_parameters', 1)
1391 if (fm_new_list(
'land_sea_runoff/atm') .le. 0)
then
1392 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/atm" list')
1395 call fm_util_set_value(
'land_sea_runoff/atm/name',
'runoff', index = ind_runoff)
1396 call fm_util_set_value(
'land_sea_runoff/atm/long_name',
'Concentration in land runoff', index = ind_runoff)
1397 call fm_util_set_value(
'land_sea_runoff/atm/units',
'mol/m^3', index = ind_runoff)
1400 if (fm_new_list(
'land_sea_runoff/ice') .le. 0)
then
1401 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/ice" list')
1410 if (fm_new_list(
'land_sea_runoff/flux') .le. 0)
then
1411 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/flux" list')
1419 if (.not. fm_change_list(
'/'))
then
1420 call mpp_error(fatal, trim(error_header) //
' Could not change to "/"')
1424 call fm_util_reset_no_overwrite
1425 call fm_util_reset_caller
1428 if (verbose >= 5)
then
1431 write (outunit,*)
'Dumping coupler_mod/types tree'
1432 if (.not. fm_dump_list(
'/coupler_mod/types',
recursive = .true.))
then
1433 call mpp_error(fatal, trim(error_header) //
' Problem dumping /coupler_mod/types tree')
1438 end module atmos_ocean_fluxes_mod
integer function, public aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, param, flag, mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity)
Set the values for a coupler flux.
subroutine, public atmos_ocean_type_fluxes_init(verbosity)
Initialize the coupler type flux tracers Initialize the /coupler_mod/types/ fields in the field manag...
subroutine, public atmos_ocean_fluxes_init(gas_fluxes, gas_fields_atm, gas_fields_ice, verbosity, use_r4_kind)
Initialize gas flux structures. Will allocate to r8_kind unless use_r4_kind is present and true.
integer, public ind_kw
The index for the piston velocity.
integer, public ind_u10
The index of the 10 m wind speed.
integer, public ind_runoff
The index for a runoff flux.
integer, public ind_csurf
The index of the ocean surface concentration.
integer, public ind_sc_no
The index for the Schmidt number for a tracer flux.
integer, public ind_deposition
The index for the atmospheric deposition flux.
integer, public ind_alpha
The index of the solubility array for a tracer.
integer, public ind_flux
The index for the tracer flux.
integer, public ind_pcair
The index of the atmospheric concentration.
integer, public ind_flux0
The index for the piston velocity.
integer, public ind_psurf
The index of the surface atmospheric pressure.
integer, public ind_deltap
The index for ocean-air gas partial pressure change.
Coupler data for 1D boundary conditions.
integer, parameter, public fm_string_len
The length of a character string representing character values for the field.
logical function, public fm_exists(name)
A function to test whether a named field exists.
logical function, public fm_change_list(name)
Change the current list. Return true on success, false otherwise.
integer function, public fm_new_list(name, create, keep)
A function to create a new list.
character(len=fms_path_len) function, public fm_get_current_list()
A function to return the full path of the current list.
integer function, public fm_get_index(name)
A function to return the index of a named field.
integer, parameter, public fm_field_name_len
The length of a character string representing the field name.
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...
logical function, public fm_dump_list(name, recursive, unit)
A function to list properties associated with a field.
A function for looping over a list.
subroutine, public fm_util_reset_no_overwrite
Reset the default value for the optional "no_overwrite" variable used in some of these subroutines to...
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.
logical function, dimension(:), pointer, public fm_util_get_logical_array(name, caller)
Get a logical value from the Field Manager tree.
subroutine, public fm_util_check_for_bad_fields(list, good_fields, caller)
Check for unrecognized fields in a list.
integer function, public fm_util_get_length(name, caller)
Get the length of an element of the Field Manager tree.
logical function, public fm_util_get_logical(name, caller, index, default_value, scalar)
Get a logical value from the Field Manager tree.
subroutine, public fm_util_set_caller(caller)
Set the default value for the optional "caller" variable used in many of these subroutines....
subroutine, public fm_util_reset_caller
Reset the default value for the optional "caller" variable used in many of these subroutines to blank...
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 ...
real(r8_kind) function, public fm_util_get_real(name, caller, index, default_value, scalar)
Get a real value from the Field Manager tree.
integer function, public fm_util_get_integer(name, caller, index, default_value, scalar)
Get an integer value from the Field Manager tree.
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.
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.
real(r8_kind) function, dimension(:), pointer, public fm_util_get_real_array(name, caller)
Get a real value from the Field Manager tree.
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.
subroutine, public write_version_number(version, tag, unit)
Prints to the log file (or a specified unit) the version id string and tag name.
integer function stdout()
This function returns the current standard fortran unit numbers for output.
integer function mpp_npes()
Returns processor count for current pelist.