39 module atmos_ocean_fluxes_mod
55 use fm_util_mod,
only: fm_util_default_caller
65 use platform_mod,
only: r4_kind, r8_kind, fms_path_len
74 character(len=*),
parameter :: mod_name =
'atmos_ocean_fluxes_mod'
75 real(r8_kind),
parameter :: epsln=1.0e-30_r8_kind
79 #include<file_version.h>
114 & mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity) &
115 & result(coupler_index)
116 character(len=*),
intent(in) :: name
117 character(len=*),
intent(in) :: flux_type
118 character(len=*),
intent(in) :: implementation
119 integer,
intent(in),
optional :: atm_tr_index
120 class(*),
intent(in),
dimension(:),
optional :: param
121 logical,
intent(in),
dimension(:),
optional :: flag
122 class(*),
intent(in),
optional :: mol_wt
123 character(len=*),
intent(in),
optional :: ice_restart_file
124 character(len=*),
intent(in),
optional :: ocean_restart_file
125 character(len=*),
intent(in),
optional :: units
126 character(len=*),
intent(in),
optional :: caller
127 integer,
intent(in),
optional :: verbosity
129 integer :: coupler_index
131 character(len=*),
parameter :: sub_name =
'aof_set_coupler_flux'
135 integer :: num_parameters
137 character(len=FMS_PATH_LEN) :: coupler_list
138 character(len=FMS_PATH_LEN) :: current_list
139 character(len=fm_string_len) :: flux_type_test
140 character(len=fm_string_len) :: implementation_test
141 character(len=256) :: error_header
142 character(len=256) :: warn_header
143 character(len=256) :: note_header
144 character(len=128) :: flux_list
145 character(len=128) :: caller_str
146 character(len=fm_string_len),
pointer,
dimension(:) :: good_list => null()
147 character(len=256) :: long_err_msg
149 character(len=17) :: err_str
152 if (
present(verbosity)) verbose = verbosity
155 if (
present(caller))
then
156 caller_str =
'[' // trim(caller) //
']'
158 caller_str = fm_util_default_caller
161 error_header =
'==>Error from ' // trim(mod_name) //&
162 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':'
163 warn_header =
'==>Warning from ' // trim(mod_name) //&
164 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':'
165 note_header =
'==>Note from ' // trim(mod_name) //&
166 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':'
169 if (name .eq.
' ')
then
170 call mpp_error(fatal, trim(error_header) //
' Empty name given')
173 if (verbose >= 5)
then
175 write (outunit,*) trim(note_header),
' Processing coupler fluxes ', trim(name)
179 coupler_list =
'/coupler_mod/fluxes/' // trim(name)
185 if (fm_exists(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list'))
then
186 if (verbose >= 5)
then
188 write (outunit,*) trim(note_header),
' Using previously defined coupler flux'
190 coupler_index = fm_get_index(coupler_list)
191 if (coupler_index .le. 0)
then
192 call mpp_error(fatal, trim(error_header) //
' Could not get coupler flux ')
199 if (
present(atm_tr_index))
then
201 write (outunit,*) trim(note_header),
' Redefining atm_tr_index to ', atm_tr_index
203 & no_create = .true., no_overwrite = .false., caller = caller_str)
209 coupler_index = fm_new_list(coupler_list)
210 if (coupler_index .le. 0)
then
211 call mpp_error(fatal, trim(error_header) //
' Could not set coupler flux ')
215 current_list = fm_get_current_list()
216 if (current_list .eq.
' ')
then
217 call mpp_error(fatal, trim(error_header) //
' Could not get the current list')
220 if (.not. fm_change_list(coupler_list))
then
221 call mpp_error(fatal, trim(error_header) //
' Could not change to the new list')
227 call fm_util_set_good_name_list(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list')
230 call fm_util_set_no_overwrite(.true.)
231 call fm_util_set_caller(caller_str)
234 if (flux_type .eq.
' ')
then
235 call mpp_error(fatal, trim(error_header) //
' Blank flux_type given')
237 if (fm_exists(
'/coupler_mod/types/' // trim(flux_type)))
then
242 flux_type_test = fm_util_get_string(
'flux_type', scalar = .true.)
243 if (.not. fm_exists(
'/coupler_mod/types/' // trim(flux_type_test)))
then
244 call mpp_error(fatal, trim(error_header) //&
245 &
' Undefined flux_type given from field_table: ' // trim(flux_type_test))
248 call mpp_error(fatal, trim(error_header) //&
249 &
' Undefined flux_type given as argument to the subroutine: ' // trim(flux_type))
253 if (implementation .eq.
' ')
then
254 call mpp_error(fatal, trim(error_header) //
' Blank flux_type given')
256 if (fm_exists(
'/coupler_mod/types/' // trim(flux_type) //
'/implementation/' // trim(implementation)))
then
261 implementation_test = fm_util_get_string(
'implementation', scalar = .true.)
262 if (.not. fm_exists(
'/coupler_mod/types/' // trim(flux_type_test) //
'/implementation/' // &
263 & trim(implementation_test)))
then
264 if (flux_type .eq. flux_type_test)
then
265 if (implementation .eq. implementation_test)
then
266 call mpp_error(fatal, trim(error_header) //
' Should not get here, as it is tested for above')
268 call mpp_error(fatal, trim(error_header) //&
269 &
' Undefined flux_type/implementation (implementation given from field_table): ' //&
270 & trim(flux_type_test) //
'/implementation/' // trim(implementation_test))
273 if (implementation .eq. implementation_test)
then
274 long_err_msg =
'Undefined flux_type/implementation (flux_type given from field_table): '
275 long_err_msg = long_err_msg // trim(flux_type_test) //
'/implementation/'&
276 & // trim(implementation_test)
277 call mpp_error(fatal, trim(error_header) // long_err_msg)
279 long_err_msg =
' Undefined flux_type/implementation (both given from field_table): '
280 long_err_msg = long_err_msg // trim(flux_type_test) //
'/implementation/'&
281 & // trim(implementation_test)
282 call mpp_error(fatal, trim(error_header) // long_err_msg)
287 call mpp_error(fatal, trim(error_header) //&
288 &
' Undefined flux_type/implementation given as argument to the subroutine: ' //&
289 & trim(flux_type) //
'/implementation/' // trim(implementation))
293 if (
present(atm_tr_index))
then
299 if (
present(mol_wt))
then
302 type is (real(r8_kind))
304 type is (real(r4_kind))
308 call mpp_error(fatal,
"aof_set_coupler_flux: invalid type for passed in mol_wt, type should be" // &
309 "real(r4_kind) or real(r8_kind). Passed in type:"//err_str)
315 if (
present(ice_restart_file))
then
321 if (
present(ocean_restart_file))
then
327 if (
present(param))
then
328 num_parameters = fm_util_get_integer(
'/coupler_mod/types/' //&
329 & trim(fm_util_get_string(
'flux_type', scalar = .true.)) //
'/implementation/' //&
330 & trim(fm_util_get_string(
'implementation', scalar = .true.)) //
'/num_parameters',&
332 length = min(
size(param(:)),num_parameters)
333 if ((length .ne. num_parameters) .and. (verbose >= 5))
then
334 write (outunit,*) trim(note_header),
' Number of parameters provided for ', trim(name),
' does not match the'
335 write (outunit,*)
'number of parameters required (',
size(param(:)),
' != ', num_parameters,
').'
336 write (outunit,*)
'This could be an error, or more likely is just a result of the implementation being'
337 write (outunit,*)
'overridden by the field table input'
339 if (length .gt. 0)
then
341 type is (real(r4_kind))
343 type is (real(r8_kind))
347 call mpp_error(fatal,
"aof_set_coupler_flux: invalid type for passed in param, type should be" // &
348 "real(r4_kind) or real(r8_kind). Passed in type:"//err_str)
357 if (
present(flag))
then
363 flux_list =
'/coupler_mod/types/' // trim(flux_type) //
'/'
365 if (
present(units))
then
370 & fm_util_get_string(trim(flux_list) //
'flux/units', index =
ind_flux))
373 do n = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
375 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = n)) //
'-units',&
376 & fm_util_get_string(trim(flux_list) //
'flux/units', index = n))
378 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = n)) //
'-long_name',&
379 & fm_util_get_string(trim(flux_list) //
'flux/long_name', index = n))
382 do n = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
383 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = n)) //&
384 &
'-units', fm_util_get_string(trim(flux_list) //
'atm/units', index = n))
385 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = n)) //
'-long_name',&
386 & fm_util_get_string(trim(flux_list) //
'atm/long_name', index = n))
389 do n = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
390 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = n)) //
'-units',&
391 & fm_util_get_string(trim(flux_list) //
'ice/units', index = n))
392 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = n)) //
'-long_name',&
393 & fm_util_get_string(trim(flux_list) //
'ice/long_name', index = n))
397 call fm_util_reset_good_name_list
398 call fm_util_reset_no_overwrite
399 call fm_util_reset_caller
402 if (.not. fm_change_list(current_list))
then
403 call mpp_error(fatal, trim(error_header) //
' Could not change back to ' // trim(current_list))
407 if (caller_str .eq.
' ')
then
408 caller_str = trim(mod_name) //
'(' // trim(sub_name) //
')'
410 good_list => fm_util_get_string_array(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list',&
411 & caller = caller_str)
412 if (
associated(good_list))
then
413 call fm_util_check_for_bad_fields(trim(coupler_list), good_list, caller = caller_str)
414 deallocate(good_list)
416 call mpp_error(fatal, trim(error_header) //
' Empty "' // trim(name) //
'" list')
464 integer,
optional,
intent(in) :: verbosity
465 logical,
optional,
intent(in) :: use_r4_kind
467 logical :: use_r4_kind_loc = .false.
469 character(len=*),
parameter :: sub_name =
'atmos_ocean_fluxes_init'
470 character(len=*),
parameter :: error_header =&
471 &
'==>Error from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):'
472 character(len=*),
parameter :: warn_header =&
473 &
'==>Warning from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):'
474 character(len=*),
parameter :: note_header =&
475 &
'==>Note from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):'
477 integer :: num_parameters
481 character(len=128) :: caller_str
482 character(len=fm_type_name_len) :: typ
483 character(len=fm_field_name_len) :: name
486 integer :: total_fluxes
487 character(len=8) :: string
488 character(len=128) :: error_string
489 character(len=128) :: flux_list
490 logical,
save :: initialized = .false.
493 if (initialized)
return
496 if (
present(verbosity)) verbose = verbosity
507 if (verbose >= 9)
then
509 write (outunit,*)
'Dumping field manager tree'
510 if (.not. fm_dump_list(
'/',
recursive = .true.)) &
511 call mpp_error(fatal, trim(error_header) //
' Problem dumping field manager tree')
514 caller_str = trim(mod_name) //
'(' // trim(sub_name) //
')'
517 call fm_util_set_no_overwrite(.true.)
518 call fm_util_set_caller(caller_str)
521 gas_fluxes%num_bcs = fm_util_get_length(
'/coupler_mod/fluxes/')
522 gas_fluxes%set = .true.
523 gas_fields_atm%num_bcs = gas_fluxes%num_bcs ; gas_fields_atm%set = .true.
524 gas_fields_ice%num_bcs = gas_fluxes%num_bcs ; gas_fields_ice%set = .true.
525 if (gas_fluxes%num_bcs .lt. 0)
then
526 call mpp_error(fatal, trim(error_header) //
' Could not get number of fluxes')
527 elseif (gas_fluxes%num_bcs .eq. 0)
then
529 write (outunit,*) trim(note_header),
' No gas fluxes'
533 write (outunit,*) trim(note_header),
' Processing ', gas_fluxes%num_bcs,
' gas fluxes'
536 if(
present(use_r4_kind)) use_r4_kind_loc = use_r4_kind
539 if( .not. use_r4_kind_loc)
then
540 allocate (gas_fluxes%bc(gas_fluxes%num_bcs))
541 allocate (gas_fields_atm%bc(gas_fields_atm%num_bcs))
542 allocate (gas_fields_ice%bc(gas_fields_ice%num_bcs))
544 allocate (gas_fluxes%bc_r4(gas_fluxes%num_bcs))
545 allocate (gas_fields_atm%bc_r4(gas_fields_atm%num_bcs))
546 allocate (gas_fields_ice%bc_r4(gas_fields_ice%num_bcs))
552 if (typ .ne.
'list')
then
553 call mpp_error(fatal, trim(error_header) //
' ' // trim(name) //
' is not a list')
560 write (outunit,*) trim(warn_header),
' Flux index, ', ind,&
561 &
' does not match array index, ', n,
' for ', trim(name)
565 if (.not. fm_change_list(
'/coupler_mod/fluxes/' // trim(name)))
then
566 call mpp_error(fatal, trim(error_header) //
' Problem changing to ' // trim(name))
571 if (.not.use_r4_kind_loc)
then
573 gas_fluxes%bc(n)%flux_type = fm_util_get_string(
'flux_type', scalar = .true.)
574 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type)))
then
575 call mpp_error(fatal, trim(error_header) //
' Undefined flux_type given for ' //&
576 & trim(name) //
': ' // trim(gas_fluxes%bc(n)%flux_type))
578 gas_fields_atm%bc(n)%flux_type = gas_fluxes%bc(n)%flux_type
579 gas_fields_ice%bc(n)%flux_type = gas_fluxes%bc(n)%flux_type
582 gas_fluxes%bc(n)%implementation = fm_util_get_string(
'implementation', scalar = .true.)
583 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type) //&
584 &
'/implementation/' // trim(gas_fluxes%bc(n)%implementation)))
then
585 call mpp_error(fatal, trim(error_header) //
' Undefined implementation given for ' //&
586 & trim(name) //
': ' // trim(gas_fluxes%bc(n)%flux_type) //
'/implementation/' //&
587 & trim(gas_fluxes%bc(n)%implementation))
589 gas_fields_atm%bc(n)%implementation = gas_fluxes%bc(n)%implementation
590 gas_fields_ice%bc(n)%implementation = gas_fluxes%bc(n)%implementation
593 flux_list =
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type) //
'/'
596 gas_fluxes%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'flux/name')
597 allocate (gas_fluxes%bc(n)%field(gas_fluxes%bc(n)%num_fields))
598 gas_fields_atm%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'atm/name')
599 allocate (gas_fields_atm%bc(n)%field(gas_fields_atm%bc(n)%num_fields))
600 gas_fields_ice%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'ice/name')
601 allocate (gas_fields_ice%bc(n)%field(gas_fields_ice%bc(n)%num_fields))
604 gas_fluxes%bc(n)%name = name
605 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
606 gas_fluxes%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
607 &
'flux/name', index = m)
608 gas_fluxes%bc(n)%field(m)%override = .false.
609 gas_fluxes%bc(n)%field(m)%mean = .false.
612 gas_fields_atm%bc(n)%name = name
613 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
614 gas_fields_atm%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
615 &
'atm/name', index = m)
616 gas_fields_atm%bc(n)%field(m)%override = .false.
617 gas_fields_atm%bc(n)%field(m)%mean = .false.
620 gas_fields_ice%bc(n)%name = name
621 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
622 gas_fields_ice%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) // &
623 &
'ice/name', index = m)
624 gas_fields_ice%bc(n)%field(m)%override = .false.
625 gas_fields_ice%bc(n)%field(m)%mean = .false.
629 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
630 gas_fluxes%bc(n)%field(m)%units =&
631 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) // &
632 &
'-units', scalar = .true.)
634 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
635 gas_fields_atm%bc(n)%field(m)%units =&
636 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-units')
638 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
639 gas_fields_ice%bc(n)%field(m)%units =&
640 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-units')
644 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
645 gas_fluxes%bc(n)%field(m)%long_name =&
646 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) // &
647 &
'-long_name', scalar = .true.)
648 gas_fluxes%bc(n)%field(m)%long_name = trim(gas_fluxes%bc(n)%field(m)%long_name) //
' for ' // name
650 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
651 gas_fields_atm%bc(n)%field(m)%long_name =&
652 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-long_name')
653 gas_fields_atm%bc(n)%field(m)%long_name = trim(gas_fields_atm%bc(n)%field(m)%long_name) //
' for ' // name
655 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
656 gas_fields_ice%bc(n)%field(m)%long_name =&
657 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-long_name')
658 gas_fields_ice%bc(n)%field(m)%long_name = trim(gas_fields_ice%bc(n)%field(m)%long_name) //
' for ' // name
662 gas_fluxes%bc(n)%atm_tr_index = fm_util_get_integer(
'atm_tr_index', scalar = .true.)
665 gas_fluxes%bc(n)%mol_wt = fm_util_get_real(
'mol_wt', scalar = .true.)
666 gas_fields_atm%bc(n)%mol_wt = gas_fluxes%bc(n)%mol_wt
667 gas_fields_ice%bc(n)%mol_wt = gas_fluxes%bc(n)%mol_wt
670 gas_fluxes%bc(n)%ice_restart_file = fm_util_get_string(
'ice_restart_file', scalar = .true.)
671 gas_fields_atm%bc(n)%ice_restart_file = gas_fluxes%bc(n)%ice_restart_file
672 gas_fields_ice%bc(n)%ice_restart_file = gas_fluxes%bc(n)%ice_restart_file
675 gas_fluxes%bc(n)%ocean_restart_file = fm_util_get_string(
'ocean_restart_file', scalar = .true.)
676 gas_fields_atm%bc(n)%ocean_restart_file = gas_fluxes%bc(n)%ocean_restart_file
677 gas_fields_ice%bc(n)%ocean_restart_file = gas_fluxes%bc(n)%ocean_restart_file
680 gas_fluxes%bc(n)%param => fm_util_get_real_array(
'param')
686 num_parameters = fm_util_get_integer(trim(flux_list) //
'implementation/' //&
687 & trim(gas_fluxes%bc(n)%implementation) //
'/num_parameters', scalar = .true.)
688 if (num_parameters .gt. 0)
then
689 if (.not.
associated(gas_fluxes%bc(n)%param))
then
690 write (error_string,
'(a,i2)')
': need ', num_parameters
691 call mpp_error(fatal, trim(error_header) //
' No param for ' // trim(name) // trim(error_string))
692 elseif (
size(gas_fluxes%bc(n)%param(:)) .ne. num_parameters)
then
693 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc(n)%param(:)),
' given, need ', num_parameters
694 call mpp_error(fatal, trim(error_header) // &
695 &
' Wrong number of param for ' // trim(name) // trim(error_string))
697 elseif (num_parameters .eq. 0)
then
698 if (
associated(gas_fluxes%bc(n)%param))
then
699 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc(n)%param(:))
700 call mpp_error(fatal, trim(error_header) //
' No params needed for ' // trim(name) // trim(error_string))
703 write (error_string,
'(a,i2)')
': ', num_parameters
704 call mpp_error(fatal, trim(error_header) // &
705 &
'Num_parameters is negative for ' // trim(name) // trim(error_string))
707 num_flags = fm_util_get_integer(trim(flux_list) //
'/num_flags', scalar = .true.)
708 if (num_flags .gt. 0)
then
709 if (.not.
associated(gas_fluxes%bc(n)%flag))
then
710 write (error_string,
'(a,i2)')
': need ', num_flags
711 call mpp_error(fatal, trim(error_header) //
' No flag for ' // trim(name) // trim(error_string))
712 elseif (
size(gas_fluxes%bc(n)%flag(:)) .ne. num_flags)
then
713 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc(n)%flag(:)),
' given, need ', num_flags
714 call mpp_error(fatal, trim(error_header) //
' Wrong number of flag for ' // trim(name)//trim(error_string))
716 elseif (num_flags .eq. 0)
then
717 if (
associated(gas_fluxes%bc(n)%flag))
then
718 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc(n)%flag(:))
719 call mpp_error(fatal, trim(error_header) //
' No flags needed for ' // trim(name) // trim(error_string))
722 write (error_string,
'(a,i2)')
': ', num_flags
723 call mpp_error(fatal, trim(error_header) //
'Num_flags is negative for ' // trim(name) // trim(error_string))
727 gas_fluxes%bc(n)%use_atm_pressure =
fm_util_get_logical(trim(flux_list) //
'/use_atm_pressure')
728 gas_fields_atm%bc(n)%use_atm_pressure = gas_fluxes%bc(n)%use_atm_pressure
729 gas_fields_ice%bc(n)%use_atm_pressure = gas_fluxes%bc(n)%use_atm_pressure
731 gas_fluxes%bc(n)%use_10m_wind_speed =
fm_util_get_logical(trim(flux_list) //
'/use_10m_wind_speed')
732 gas_fields_atm%bc(n)%use_10m_wind_speed = gas_fluxes%bc(n)%use_10m_wind_speed
733 gas_fields_ice%bc(n)%use_10m_wind_speed = gas_fluxes%bc(n)%use_10m_wind_speed
735 gas_fluxes%bc(n)%pass_through_ice =
fm_util_get_logical(trim(flux_list) //
'/pass_through_ice')
736 gas_fields_atm%bc(n)%pass_through_ice = gas_fluxes%bc(n)%pass_through_ice
737 gas_fields_ice%bc(n)%pass_through_ice = gas_fluxes%bc(n)%pass_through_ice
742 gas_fluxes%bc_r4(n)%flux_type = fm_util_get_string(
'flux_type', scalar = .true.)
743 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type)))
then
744 call mpp_error(fatal, trim(error_header) //
' Undefined flux_type given for ' //&
745 & trim(name) //
': ' // trim(gas_fluxes%bc_r4(n)%flux_type))
747 gas_fields_atm%bc_r4(n)%flux_type = gas_fluxes%bc_r4(n)%flux_type
748 gas_fields_ice%bc_r4(n)%flux_type = gas_fluxes%bc_r4(n)%flux_type
751 gas_fluxes%bc_r4(n)%implementation = fm_util_get_string(
'implementation', scalar = .true.)
752 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type) //&
753 &
'/implementation/' // trim(gas_fluxes%bc_r4(n)%implementation)))
then
754 call mpp_error(fatal, trim(error_header) //
' Undefined implementation given for ' //&
755 & trim(name) //
': ' // trim(gas_fluxes%bc_r4(n)%flux_type) //
'/implementation/' //&
756 & trim(gas_fluxes%bc_r4(n)%implementation))
758 gas_fields_atm%bc_r4(n)%implementation = gas_fluxes%bc_r4(n)%implementation
759 gas_fields_ice%bc_r4(n)%implementation = gas_fluxes%bc_r4(n)%implementation
762 flux_list =
'/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type) //
'/'
765 gas_fluxes%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) //
'flux/name')
766 allocate (gas_fluxes%bc_r4(n)%field(gas_fluxes%bc_r4(n)%num_fields))
767 gas_fields_atm%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) //
'atm/name')
768 allocate (gas_fields_atm%bc_r4(n)%field(gas_fields_atm%bc_r4(n)%num_fields))
769 gas_fields_ice%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) //
'ice/name')
770 allocate (gas_fields_ice%bc_r4(n)%field(gas_fields_ice%bc_r4(n)%num_fields))
773 gas_fluxes%bc_r4(n)%name = name
774 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
775 gas_fluxes%bc_r4(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
776 &
'flux/name', index = m)
777 gas_fluxes%bc_r4(n)%field(m)%override = .false.
778 gas_fluxes%bc_r4(n)%field(m)%mean = .false.
781 gas_fields_atm%bc_r4(n)%name = name
782 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
783 gas_fields_atm%bc_r4(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
784 &
'atm/name', index = m)
785 gas_fields_atm%bc_r4(n)%field(m)%override = .false.
786 gas_fields_atm%bc_r4(n)%field(m)%mean = .false.
789 gas_fields_ice%bc_r4(n)%name = name
790 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
791 gas_fields_ice%bc_r4(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) // &
792 &
'ice/name', index = m)
793 gas_fields_ice%bc_r4(n)%field(m)%override = .false.
794 gas_fields_ice%bc_r4(n)%field(m)%mean = .false.
798 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
799 gas_fluxes%bc_r4(n)%field(m)%units =&
800 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) // &
801 &
'-units', scalar = .true.)
803 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
804 gas_fields_atm%bc_r4(n)%field(m)%units =&
805 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-units')
807 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
808 gas_fields_ice%bc_r4(n)%field(m)%units =&
809 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-units')
813 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
814 gas_fluxes%bc_r4(n)%field(m)%long_name =&
815 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) // &
816 &
'-long_name', scalar = .true.)
817 gas_fluxes%bc_r4(n)%field(m)%long_name = trim(gas_fluxes%bc_r4(n)%field(m)%long_name) //
' for ' // name
819 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
820 gas_fields_atm%bc_r4(n)%field(m)%long_name =&
821 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-long_name')
822 gas_fields_atm%bc_r4(n)%field(m)%long_name = trim(gas_fields_atm%bc_r4(n)%field(m)%long_name)// &
825 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
826 gas_fields_ice%bc_r4(n)%field(m)%long_name =&
827 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-long_name')
828 gas_fields_ice%bc_r4(n)%field(m)%long_name = trim(gas_fields_ice%bc_r4(n)%field(m)%long_name) // &
833 gas_fluxes%bc_r4(n)%atm_tr_index = fm_util_get_integer(
'atm_tr_index', scalar = .true.)
836 gas_fluxes%bc_r4(n)%mol_wt = fm_util_get_real(
'mol_wt', scalar = .true.)
837 gas_fields_atm%bc_r4(n)%mol_wt = gas_fluxes%bc_r4(n)%mol_wt
838 gas_fields_ice%bc_r4(n)%mol_wt = gas_fluxes%bc_r4(n)%mol_wt
841 gas_fluxes%bc_r4(n)%ice_restart_file = fm_util_get_string(
'ice_restart_file', scalar = .true.)
842 gas_fields_atm%bc_r4(n)%ice_restart_file = gas_fluxes%bc_r4(n)%ice_restart_file
843 gas_fields_ice%bc_r4(n)%ice_restart_file = gas_fluxes%bc_r4(n)%ice_restart_file
846 gas_fluxes%bc_r4(n)%ocean_restart_file = fm_util_get_string(
'ocean_restart_file', scalar = .true.)
847 gas_fields_atm%bc_r4(n)%ocean_restart_file = gas_fluxes%bc_r4(n)%ocean_restart_file
848 gas_fields_ice%bc_r4(n)%ocean_restart_file = gas_fluxes%bc_r4(n)%ocean_restart_file
851 gas_fluxes%bc_r4(n)%param => fm_util_get_real_array(
'param')
857 num_parameters = fm_util_get_integer(trim(flux_list) //
'implementation/' //&
858 & trim(gas_fluxes%bc_r4(n)%implementation) //
'/num_parameters', scalar = .true.)
859 if (num_parameters .gt. 0)
then
860 if (.not.
associated(gas_fluxes%bc_r4(n)%param))
then
861 write (error_string,
'(a,i2)')
': need ', num_parameters
862 call mpp_error(fatal, trim(error_header) //
' No param for ' // trim(name) // trim(error_string))
863 elseif (
size(gas_fluxes%bc_r4(n)%param(:)) .ne. num_parameters)
then
864 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc_r4(n)%param(:)),
' given, need ', num_parameters
865 call mpp_error(fatal, trim(error_header) // &
866 &
' Wrong number of param for ' // trim(name) // trim(error_string))
868 elseif (num_parameters .eq. 0)
then
869 if (
associated(gas_fluxes%bc_r4(n)%param))
then
870 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc_r4(n)%param(:))
871 call mpp_error(fatal, trim(error_header) //
' No params needed for ' // trim(name) // trim(error_string))
874 write (error_string,
'(a,i2)')
': ', num_parameters
875 call mpp_error(fatal, trim(error_header) // &
876 &
'Num_parameters is negative for ' // trim(name) // trim(error_string))
878 num_flags = fm_util_get_integer(trim(flux_list) //
'/num_flags', scalar = .true.)
879 if (num_flags .gt. 0)
then
880 if (.not.
associated(gas_fluxes%bc_r4(n)%flag))
then
881 write (error_string,
'(a,i2)')
': need ', num_flags
882 call mpp_error(fatal, trim(error_header) //
' No flag for ' // trim(name) // trim(error_string))
883 elseif (
size(gas_fluxes%bc_r4(n)%flag(:)) .ne. num_flags)
then
884 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc_r4(n)%flag(:)),
' given, need ', num_flags
885 call mpp_error(fatal, trim(error_header) //
' Wrong number of flag for '//trim(name)//trim(error_string))
887 elseif (num_flags .eq. 0)
then
888 if (
associated(gas_fluxes%bc_r4(n)%flag))
then
889 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc_r4(n)%flag(:))
890 call mpp_error(fatal, trim(error_header) //
' No flags needed for ' // trim(name) // trim(error_string))
893 write (error_string,
'(a,i2)')
': ', num_flags
894 call mpp_error(fatal, trim(error_header) //
'Num_flags is negative for ' // trim(name) // trim(error_string))
898 gas_fluxes%bc_r4(n)%use_atm_pressure =
fm_util_get_logical(trim(flux_list) //
'/use_atm_pressure')
899 gas_fields_atm%bc_r4(n)%use_atm_pressure = gas_fluxes%bc_r4(n)%use_atm_pressure
900 gas_fields_ice%bc_r4(n)%use_atm_pressure = gas_fluxes%bc_r4(n)%use_atm_pressure
902 gas_fluxes%bc_r4(n)%use_10m_wind_speed =
fm_util_get_logical(trim(flux_list) //
'/use_10m_wind_speed')
903 gas_fields_atm%bc_r4(n)%use_10m_wind_speed = gas_fluxes%bc_r4(n)%use_10m_wind_speed
904 gas_fields_ice%bc_r4(n)%use_10m_wind_speed = gas_fluxes%bc_r4(n)%use_10m_wind_speed
906 gas_fluxes%bc_r4(n)%pass_through_ice =
fm_util_get_logical(trim(flux_list) //
'/pass_through_ice')
907 gas_fields_atm%bc_r4(n)%pass_through_ice = gas_fluxes%bc_r4(n)%pass_through_ice
908 gas_fields_ice%bc_r4(n)%pass_through_ice = gas_fluxes%bc_r4(n)%pass_through_ice
912 if (verbose >= 5)
then
914 write (outunit,*)
'Dumping fluxes tracer tree'
915 if (.not. fm_dump_list(
'/coupler_mod/fluxes',
recursive = .true.))
then
916 call mpp_error(fatal, trim(error_header) //
' Problem dumping fluxes tracer tree')
923 total_fluxes = gas_fluxes%num_bcs
925 if (total_fluxes .ne.
mpp_npes() * gas_fluxes%num_bcs)
then
926 write (string,
'(i4)') gas_fluxes%num_bcs
927 call mpp_error(fatal, trim(error_header) //&
928 &
' Number of fluxes does not match across the processors: ' // trim(string) //
' fluxes')
932 call fm_util_reset_no_overwrite
933 call fm_util_reset_caller
1103 integer,
intent(in),
optional :: verbosity
1107 character(len=*),
parameter :: sub_name =
'atmos_ocean_type_fluxes_init'
1108 character(len=*),
parameter :: caller_str =&
1109 & trim(mod_name) //
'(' // trim(sub_name) //
')'
1110 character(len=*),
parameter :: error_header =&
1111 &
'==>Error from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):'
1112 logical,
save :: initialized = .false.
1114 if (initialized)
return
1117 if (
present(verbosity)) verbose = verbosity
1119 initialized = .true.
1121 call fm_util_set_no_overwrite(.true.)
1122 call fm_util_set_caller(caller_str)
1125 if (fm_new_list(
'/coupler_mod') .le. 0)
then
1126 call mpp_error(fatal, trim(error_header) //
' Could not set the "coupler_mod" list')
1129 if (fm_new_list(
'/coupler_mod/GOOD') .le. 0)
then
1130 call mpp_error(fatal, trim(error_header) //
' Could not set the "GOOD" list')
1132 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'GOOD', append = .true.)
1134 if (fm_new_list(
'/coupler_mod/fluxes') .le. 0)
then
1135 call mpp_error(fatal, trim(error_header) //
' Could not set the "/coupler_mod/fluxes" list')
1137 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'fluxes', append = .true.)
1139 if (fm_new_list(
'/coupler_mod/types') .le. 0)
then
1140 call mpp_error(fatal, trim(error_header) //
' Could not set the "/coupler_mod/types" list')
1142 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'types', append = .true.)
1145 if (.not. fm_change_list(
'/coupler_mod/types'))
then
1146 call mpp_error(fatal, trim(error_header) //
' Could not change to "/coupler_mod/types"')
1151 if (fm_new_list(
'air_sea_gas_flux_generic') .le. 0)
then
1152 call mpp_error(fatal, trim(error_header) //&
1153 &
' Could not set the "air_sea_gas_flux_generic" list')
1157 if (fm_new_list(
'air_sea_gas_flux_generic/implementation') .le. 0)
then
1158 call mpp_error(fatal, trim(error_header) //&
1159 &
' Could not set the "air_sea_gas_flux_generic/implementation" list')
1163 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/ocmip2') .le. 0)
then
1164 call mpp_error(fatal, trim(error_header) //&
1165 &
' Could not set the "air_sea_gas_flux_generic/implementation/ocmip2" list')
1167 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/ocmip2/num_parameters', 2)
1169 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/duce') .le. 0)
then
1170 call mpp_error(fatal, trim(error_header) //&
1171 &
' Could not set the "air_sea_gas_flux_generic/implementation/duce" list')
1173 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/duce/num_parameters', 1)
1175 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/johnson') .le. 0)
then
1176 call mpp_error(fatal, trim(error_header) // &
1177 &
' Could not set the "air_sea_gas_flux_generic/implementation/johnson" list')
1179 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/johnson/num_parameters', 2)
1188 if (fm_new_list(
'air_sea_gas_flux_generic/atm') .le. 0)
then
1189 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/atm" list')
1192 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'pcair', index = ind_pcair)
1193 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Atmospheric concentration', index = ind_pcair)
1194 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'mol/mol', index = ind_pcair)
1196 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'u10', index = ind_u10)
1197 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Wind speed at 10 m', index = ind_u10)
1198 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'm/s', index = ind_u10)
1200 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'psurf', index = ind_psurf)
1201 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Surface atmospheric pressure', index = ind_psurf)
1202 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'Pa', index = ind_psurf)
1205 if (fm_new_list(
'air_sea_gas_flux_generic/ice') .le. 0)
then
1206 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/ice" list')
1209 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'alpha', index = ind_alpha)
1210 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Solubility w.r.t. atmosphere', index = ind_alpha)
1211 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'mol/m^3/atm', index = ind_alpha)
1213 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'csurf', index = ind_csurf)
1214 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Ocean concentration', index = ind_csurf)
1215 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'mol/m^3', index = ind_csurf)
1217 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'sc_no', index = ind_sc_no)
1218 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Schmidt number', index = ind_sc_no)
1219 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'dimensionless', index = ind_sc_no)
1222 if (fm_new_list(
'air_sea_gas_flux_generic/flux') .le. 0)
then
1223 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/flux" list')
1243 if (fm_new_list(
'air_sea_gas_flux') .le. 0)
then
1244 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux" list')
1248 if (fm_new_list(
'air_sea_gas_flux/implementation') .le. 0)
then
1249 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation" list')
1253 if (fm_new_list(
'air_sea_gas_flux/implementation/ocmip2') .le. 0)
then
1254 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation/ocmip2" list')
1256 call fm_util_set_value(
'air_sea_gas_flux/implementation/ocmip2/num_parameters', 2)
1257 if (fm_new_list(
'air_sea_gas_flux/implementation/ocmip2_data') .le. 0)
then
1258 call mpp_error(fatal, trim(error_header) // &
1259 &
' Could not set the "air_sea_gas_flux/implementation/ocmip2_data" list')
1261 call fm_util_set_value(
'air_sea_gas_flux/implementation/ocmip2_data/num_parameters', 2)
1262 if (fm_new_list(
'air_sea_gas_flux/implementation/linear') .le. 0)
then
1263 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation/linear" list')
1265 call fm_util_set_value(
'air_sea_gas_flux/implementation/linear/num_parameters', 3)
1274 if (fm_new_list(
'air_sea_gas_flux/atm') .le. 0)
then
1275 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/atm" list')
1279 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Atmospheric concentration', index = ind_pcair)
1280 call fm_util_set_value(
'air_sea_gas_flux/atm/units',
'mol/mol', index = ind_pcair)
1283 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Wind speed at 10 m', index = ind_u10)
1287 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Surface atmospheric pressure', index = ind_psurf)
1291 if (fm_new_list(
'air_sea_gas_flux/ice') .le. 0)
then
1292 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/ice" list')
1297 &
'Solubility from atmosphere times Schmidt number term', index = ind_alpha)
1298 call fm_util_set_value(
'air_sea_gas_flux/ice/units',
'mol/m^3/atm', index = ind_alpha)
1301 call fm_util_set_value(
'air_sea_gas_flux/ice/long_name',
'Ocean concentration times Schmidt number term', &
1302 & index = ind_csurf)
1303 call fm_util_set_value(
'air_sea_gas_flux/ice/units',
'mol/m^3', index = ind_csurf)
1306 if (fm_new_list(
'air_sea_gas_flux/flux') .le. 0)
then
1307 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/flux" list')
1315 if (fm_new_list(
'air_sea_deposition') .le. 0)
then
1316 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition" list')
1320 if (fm_new_list(
'air_sea_deposition/implementation') .le. 0)
then
1321 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation" list')
1325 if (fm_new_list(
'air_sea_deposition/implementation/dry') .le. 0)
then
1326 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation/dry" list')
1328 call fm_util_set_value(
'air_sea_deposition/implementation/dry/num_parameters', 1)
1329 if (fm_new_list(
'air_sea_deposition/implementation/wet') .le. 0)
then
1330 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation/wet" list')
1332 call fm_util_set_value(
'air_sea_deposition/implementation/wet/num_parameters', 1)
1341 if (fm_new_list(
'air_sea_deposition/atm') .le. 0)
then
1342 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/atm" list')
1345 call fm_util_set_value(
'air_sea_deposition/atm/name',
'deposition', index = ind_deposition)
1346 call fm_util_set_value(
'air_sea_deposition/atm/long_name',
'Atmospheric deposition', index = ind_deposition)
1347 call fm_util_set_value(
'air_sea_deposition/atm/units',
'kg/m^2/s', index = ind_deposition)
1350 if (fm_new_list(
'air_sea_deposition/ice') .le. 0)
then
1351 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/ice" list')
1359 if (fm_new_list(
'air_sea_deposition/flux') .le. 0)
then
1360 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/flux" list')
1368 if (fm_new_list(
'land_sea_runoff') .le. 0)
then
1369 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff" list')
1373 if (fm_new_list(
'land_sea_runoff/implementation') .le. 0)
then
1374 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/implementation" list')
1378 if (fm_new_list(
'land_sea_runoff/implementation/river') .le. 0)
then
1379 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/implementation/river" list')
1381 call fm_util_set_value(
'land_sea_runoff/implementation/river/num_parameters', 1)
1390 if (fm_new_list(
'land_sea_runoff/atm') .le. 0)
then
1391 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/atm" list')
1394 call fm_util_set_value(
'land_sea_runoff/atm/name',
'runoff', index = ind_runoff)
1395 call fm_util_set_value(
'land_sea_runoff/atm/long_name',
'Concentration in land runoff', index = ind_runoff)
1396 call fm_util_set_value(
'land_sea_runoff/atm/units',
'mol/m^3', index = ind_runoff)
1399 if (fm_new_list(
'land_sea_runoff/ice') .le. 0)
then
1400 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/ice" list')
1409 if (fm_new_list(
'land_sea_runoff/flux') .le. 0)
then
1410 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/flux" list')
1418 if (.not. fm_change_list(
'/'))
then
1419 call mpp_error(fatal, trim(error_header) //
' Could not change to "/"')
1423 call fm_util_reset_no_overwrite
1424 call fm_util_reset_caller
1427 if (verbose >= 5)
then
1430 write (outunit,*)
'Dumping coupler_mod/types tree'
1431 if (.not. fm_dump_list(
'/coupler_mod/types',
recursive = .true.))
then
1432 call mpp_error(fatal, trim(error_header) //
' Problem dumping /coupler_mod/types tree')
1437 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.