40 use fms_mod,
only: write_version_number
71 character(len=*),
parameter ::
mod_name =
'atmos_ocean_fluxes_mod' 72 real,
parameter ::
epsln=1.0e-30
76 #include<file_version.h> 106 & mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity) &
107 & result(coupler_index)
108 character(len=*),
intent(in) :: name
109 character(len=*),
intent(in) :: flux_type
110 character(len=*),
intent(in) :: implementation
111 integer,
intent(in),
optional :: atm_tr_index
112 real,
intent(in),
dimension(:),
optional :: param
113 logical,
intent(in),
dimension(:),
optional :: flag
114 real,
intent(in),
optional :: mol_wt
115 character(len=*),
intent(in),
optional :: ice_restart_file
116 character(len=*),
intent(in),
optional :: ocean_restart_file
117 character(len=*),
intent(in),
optional :: units
118 character(len=*),
intent(in),
optional :: caller
119 integer,
intent(in),
optional :: verbosity
121 integer :: coupler_index
123 character(len=*),
parameter :: sub_name =
'aof_set_coupler_flux' 127 integer :: num_parameters
129 character(len=fm_path_name_len) :: coupler_list
130 character(len=fm_path_name_len) :: current_list
131 character(len=fm_string_len) :: flux_type_test
132 character(len=fm_string_len) :: implementation_test
133 character(len=256) :: error_header
134 character(len=256) :: warn_header
135 character(len=256) :: note_header
136 character(len=128) :: flux_list
137 character(len=128) :: caller_str
138 character(len=fm_string_len),
pointer,
dimension(:) :: good_list => null()
139 character(len=256) :: long_err_msg
143 if (
present(verbosity)) verbose = verbosity
146 if (
present(caller))
then 147 caller_str =
'[' // trim(caller) //
']' 149 caller_str = fm_util_default_caller
152 error_header =
'==>Error from ' // trim(
mod_name) //&
153 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':' 154 warn_header =
'==>Warning from ' // trim(
mod_name) //&
155 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':' 156 note_header =
'==>Note from ' // trim(
mod_name) //&
157 &
'(' // trim(sub_name) //
')' // trim(caller_str) //
':' 160 if (name .eq.
' ')
then 161 call mpp_error(fatal, trim(error_header) //
' Empty name given')
164 if (verbose >= 5)
then 166 write (outunit,*) trim(note_header),
' Processing coupler fluxes ', trim(name)
170 coupler_list =
'/coupler_mod/fluxes/' // trim(name)
176 if (fm_exists(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list'))
then 177 if (verbose >= 5)
then 179 write (outunit,*) trim(note_header),
' Using previously defined coupler flux' 181 coupler_index = fm_get_index(coupler_list)
182 if (coupler_index .le. 0)
then 183 call mpp_error(fatal, trim(error_header) //
' Could not get coupler flux ')
190 if (
present(atm_tr_index))
then 192 write (outunit,*) trim(note_header),
' Redefining atm_tr_index to ', atm_tr_index
194 & no_create = .true., no_overwrite = .false., caller = caller_str)
200 coupler_index = fm_new_list(coupler_list)
201 if (coupler_index .le. 0)
then 202 call mpp_error(fatal, trim(error_header) //
' Could not set coupler flux ')
206 current_list = fm_get_current_list()
207 if (current_list .eq.
' ')
then 208 call mpp_error(fatal, trim(error_header) //
' Could not get the current list')
211 if (.not. fm_change_list(coupler_list))
then 212 call mpp_error(fatal, trim(error_header) //
' Could not change to the new list')
218 call fm_util_set_good_name_list(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list')
221 call fm_util_set_no_overwrite(.true.)
222 call fm_util_set_caller(caller_str)
225 if (flux_type .eq.
' ')
then 226 call mpp_error(fatal, trim(error_header) //
' Blank flux_type given')
228 if (fm_exists(
'/coupler_mod/types/' // trim(flux_type)))
then 233 flux_type_test = fm_util_get_string(
'flux_type', scalar = .true.)
234 if (.not. fm_exists(
'/coupler_mod/types/' // trim(flux_type_test)))
then 235 call mpp_error(fatal, trim(error_header) //&
236 &
' Undefined flux_type given from field_table: ' // trim(flux_type_test))
239 call mpp_error(fatal, trim(error_header) //&
240 &
' Undefined flux_type given as argument to the subroutine: ' // trim(flux_type))
244 if (implementation .eq.
' ')
then 245 call mpp_error(fatal, trim(error_header) //
' Blank flux_type given')
247 if (fm_exists(
'/coupler_mod/types/' // trim(flux_type) //
'/implementation/' // trim(implementation)))
then 252 implementation_test = fm_util_get_string(
'implementation', scalar = .true.)
253 if (.not. fm_exists(
'/coupler_mod/types/' // trim(flux_type_test) //
'/implementation/' // trim(implementation_test)))
then 254 if (flux_type .eq. flux_type_test)
then 255 if (implementation .eq. implementation_test)
then 256 call mpp_error(fatal, trim(error_header) //
' Should not get here, as it is tested for above')
258 call mpp_error(fatal, trim(error_header) //&
259 &
' Undefined flux_type/implementation (implementation given from field_table): ' //&
260 & trim(flux_type_test) //
'/implementation/' // trim(implementation_test))
263 if (implementation .eq. implementation_test)
then 264 long_err_msg =
'Undefined flux_type/implementation (flux_type given from field_table): ' 265 long_err_msg = long_err_msg // trim(flux_type_test) //
'/implementation/'&
266 & // trim(implementation_test)
267 call mpp_error(fatal, trim(error_header) // long_err_msg)
269 long_err_msg =
' Undefined flux_type/implementation (both given from field_table): ' 270 long_err_msg = long_err_msg // trim(flux_type_test) //
'/implementation/'&
271 & // trim(implementation_test)
272 call mpp_error(fatal, trim(error_header) // long_err_msg)
277 call mpp_error(fatal, trim(error_header) //&
278 &
' Undefined flux_type/implementation given as argument to the subroutine: ' //&
279 & trim(flux_type) //
'/implementation/' // trim(implementation))
283 if (
present(atm_tr_index))
then 289 if (
present(mol_wt))
then 295 if (
present(ice_restart_file))
then 301 if (
present(ocean_restart_file))
then 307 if (
present(param))
then 308 num_parameters = fm_util_get_integer(
'/coupler_mod/types/' //&
309 & trim(fm_util_get_string(
'flux_type', scalar = .true.)) //
'/implementation/' //&
310 & trim(fm_util_get_string(
'implementation', scalar = .true.)) //
'/num_parameters',&
312 length =
min(
size(param(:)),num_parameters)
313 if ((length .ne. num_parameters) .and. (verbose >= 5))
then 314 write (outunit,*) trim(note_header),
' Number of parameters provided for ', trim(name),
' does not match the' 315 write (outunit,*)
'number of parameters required (',
size(param(:)),
' != ', num_parameters,
').' 316 write (outunit,*)
'This could be an error, or more likely is just a result of the implementation being' 317 write (outunit,*)
'overridden by the field table input' 319 if (length .gt. 0)
then 328 if (
present(flag))
then 334 flux_list =
'/coupler_mod/types/' // trim(flux_type) //
'/' 336 if (
present(units))
then 341 & fm_util_get_string(trim(flux_list) //
'flux/units', index =
ind_flux))
344 do n = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
346 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = n)) //
'-units',&
347 & fm_util_get_string(trim(flux_list) //
'flux/units', index = n))
349 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = n)) //
'-long_name',&
350 & fm_util_get_string(trim(flux_list) //
'flux/long_name', index = n))
353 do n = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
354 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = n)) //&
355 &
'-units', fm_util_get_string(trim(flux_list) //
'atm/units', index = n))
356 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = n)) //
'-long_name',&
357 & fm_util_get_string(trim(flux_list) //
'atm/long_name', index = n))
360 do n = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
361 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = n)) //
'-units',&
362 & fm_util_get_string(trim(flux_list) //
'ice/units', index = n))
363 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = n)) //
'-long_name',&
364 & fm_util_get_string(trim(flux_list) //
'ice/long_name', index = n))
368 call fm_util_reset_good_name_list
369 call fm_util_reset_no_overwrite
370 call fm_util_reset_caller
373 if (.not. fm_change_list(current_list))
then 374 call mpp_error(fatal, trim(error_header) //
' Could not change back to ' // trim(current_list))
378 if (caller_str .eq.
' ')
then 379 caller_str = trim(
mod_name) //
'(' // trim(sub_name) //
')' 381 good_list => fm_util_get_string_array(
'/coupler_mod/GOOD/fluxes/' // trim(name) //
'/good_list',&
382 & caller = caller_str)
383 if (
associated(good_list))
then 384 call fm_util_check_for_bad_fields(trim(coupler_list), good_list, caller = caller_str)
385 deallocate(good_list)
387 call mpp_error(fatal, trim(error_header) //
' Empty "' // trim(name) //
'" list')
440 integer,
optional,
intent(in) :: verbosity
442 character(len=*),
parameter :: sub_name =
'atmos_ocean_fluxes_init' 443 character(len=*),
parameter :: error_header =&
444 &
'==>Error from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):' 445 character(len=*),
parameter :: warn_header =&
446 &
'==>Warning from ' // trim(
mod_name) //
'(' // trim(sub_name) //
'):' 447 character(len=*),
parameter :: note_header =&
448 &
'==>Note from ' // trim(mod_name) //
'(' // trim(sub_name) //
'):' 450 integer :: num_parameters
454 character(len=128) :: caller_str
455 character(len=fm_type_name_len) :: typ
456 character(len=fm_field_name_len) :: name
459 integer :: total_fluxes
460 character(len=8) :: string
461 character(len=128) :: error_string
462 character(len=128) :: flux_list
463 logical,
save :: initialized = .false.
466 if (initialized)
return 469 if (
present(verbosity)) verbose = verbosity
472 call write_version_number(trim(
mod_name), version)
480 if (verbose >= 9)
then 482 write (outunit,*)
'Dumping field manager tree' 483 if (.not. fm_dump_list(
'/',
recursive = .true.)) &
484 call mpp_error(fatal, trim(error_header) //
' Problem dumping field manager tree')
487 caller_str = trim(
mod_name) //
'(' // trim(sub_name) //
')' 490 call fm_util_set_no_overwrite(.true.)
491 call fm_util_set_caller(caller_str)
494 gas_fluxes%num_bcs = fm_util_get_length(
'/coupler_mod/fluxes/')
495 gas_fluxes%set = .true.
496 gas_fields_atm%num_bcs = gas_fluxes%num_bcs ; gas_fields_atm%set = .true.
497 gas_fields_ice%num_bcs = gas_fluxes%num_bcs ; gas_fields_ice%set = .true.
498 if (gas_fluxes%num_bcs .lt. 0)
then 499 call mpp_error(fatal, trim(error_header) //
' Could not get number of fluxes')
500 elseif (gas_fluxes%num_bcs .eq. 0)
then 502 write (outunit,*) trim(note_header),
' No gas fluxes' 506 write (outunit,*) trim(note_header),
' Processing ', gas_fluxes%num_bcs,
' gas fluxes' 510 allocate (gas_fluxes%bc(gas_fluxes%num_bcs))
511 allocate (gas_fields_atm%bc(gas_fields_atm%num_bcs))
512 allocate (gas_fields_ice%bc(gas_fields_ice%num_bcs))
517 if (typ .ne.
'list')
then 518 call mpp_error(fatal, trim(error_header) //
' ' // trim(name) //
' is not a list')
525 write (outunit,*) trim(warn_header),
' Flux index, ', ind,&
526 &
' does not match array index, ', n,
' for ', trim(name)
530 if (.not. fm_change_list(
'/coupler_mod/fluxes/' // trim(name)))
then 531 call mpp_error(fatal, trim(error_header) //
' Problem changing to ' // trim(name))
535 gas_fluxes%bc(n)%flux_type = fm_util_get_string(
'flux_type', scalar = .true.)
536 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type)))
then 537 call mpp_error(fatal, trim(error_header) //
' Undefined flux_type given for ' //&
538 & trim(name) //
': ' // trim(gas_fluxes%bc(n)%flux_type))
540 gas_fields_atm%bc(n)%flux_type = gas_fluxes%bc(n)%flux_type
541 gas_fields_ice%bc(n)%flux_type = gas_fluxes%bc(n)%flux_type
544 gas_fluxes%bc(n)%implementation = fm_util_get_string(
'implementation', scalar = .true.)
545 if (.not. fm_exists(
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type) //&
546 &
'/implementation/' // trim(gas_fluxes%bc(n)%implementation)))
then 547 call mpp_error(fatal, trim(error_header) //
' Undefined implementation given for ' //&
548 & trim(name) //
': ' // trim(gas_fluxes%bc(n)%flux_type) //
'/implementation/' //&
549 & trim(gas_fluxes%bc(n)%implementation))
551 gas_fields_atm%bc(n)%implementation = gas_fluxes%bc(n)%implementation
552 gas_fields_ice%bc(n)%implementation = gas_fluxes%bc(n)%implementation
555 flux_list =
'/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type) //
'/' 558 gas_fluxes%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'flux/name')
559 allocate (gas_fluxes%bc(n)%field(gas_fluxes%bc(n)%num_fields))
560 gas_fields_atm%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'atm/name')
561 allocate (gas_fields_atm%bc(n)%field(gas_fields_atm%bc(n)%num_fields))
562 gas_fields_ice%bc(n)%num_fields = fm_util_get_length(trim(flux_list) //
'ice/name')
563 allocate (gas_fields_ice%bc(n)%field(gas_fields_ice%bc(n)%num_fields))
566 gas_fluxes%bc(n)%name = name
567 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
568 gas_fluxes%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
569 &
'flux/name', index = m)
570 gas_fluxes%bc(n)%field(m)%override = .false.
571 gas_fluxes%bc(n)%field(m)%mean = .false.
574 gas_fields_atm%bc(n)%name = name
575 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
576 gas_fields_atm%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //&
577 &
'atm/name', index = m)
578 gas_fields_atm%bc(n)%field(m)%override = .false.
579 gas_fields_atm%bc(n)%field(m)%mean = .false.
582 gas_fields_ice%bc(n)%name = name
583 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
584 gas_fields_ice%bc(n)%field(m)%name = trim(name) //
"_" // fm_util_get_string(trim(flux_list) //
'ice/name', index = m)
585 gas_fields_ice%bc(n)%field(m)%override = .false.
586 gas_fields_ice%bc(n)%field(m)%mean = .false.
590 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
591 gas_fluxes%bc(n)%field(m)%units =&
592 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) //
'-units', scalar = .true.)
594 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
595 gas_fields_atm%bc(n)%field(m)%units =&
596 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-units')
598 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
599 gas_fields_ice%bc(n)%field(m)%units =&
600 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-units')
604 do m = 1, fm_util_get_length(trim(flux_list) //
'flux/name')
605 gas_fluxes%bc(n)%field(m)%long_name =&
606 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'flux/name', index = m)) //
'-long_name', scalar = .true.)
607 gas_fluxes%bc(n)%field(m)%long_name = trim(gas_fluxes%bc(n)%field(m)%long_name) //
' for ' // name
609 do m = 1, fm_util_get_length(trim(flux_list) //
'atm/name')
610 gas_fields_atm%bc(n)%field(m)%long_name =&
611 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'atm/name', index = m)) //
'-long_name')
612 gas_fields_atm%bc(n)%field(m)%long_name = trim(gas_fields_atm%bc(n)%field(m)%long_name) //
' for ' // name
614 do m = 1, fm_util_get_length(trim(flux_list) //
'ice/name')
615 gas_fields_ice%bc(n)%field(m)%long_name =&
616 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) //
'ice/name', index = m)) //
'-long_name')
617 gas_fields_ice%bc(n)%field(m)%long_name = trim(gas_fields_ice%bc(n)%field(m)%long_name) //
' for ' // name
621 gas_fluxes%bc(n)%atm_tr_index = fm_util_get_integer(
'atm_tr_index', scalar = .true.)
624 gas_fluxes%bc(n)%mol_wt = fm_util_get_real(
'mol_wt', scalar = .true.)
625 gas_fields_atm%bc(n)%mol_wt = gas_fluxes%bc(n)%mol_wt
626 gas_fields_ice%bc(n)%mol_wt = gas_fluxes%bc(n)%mol_wt
629 gas_fluxes%bc(n)%ice_restart_file = fm_util_get_string(
'ice_restart_file', scalar = .true.)
630 gas_fields_atm%bc(n)%ice_restart_file = gas_fluxes%bc(n)%ice_restart_file
631 gas_fields_ice%bc(n)%ice_restart_file = gas_fluxes%bc(n)%ice_restart_file
634 gas_fluxes%bc(n)%ocean_restart_file = fm_util_get_string(
'ocean_restart_file', scalar = .true.)
635 gas_fields_atm%bc(n)%ocean_restart_file = gas_fluxes%bc(n)%ocean_restart_file
636 gas_fields_ice%bc(n)%ocean_restart_file = gas_fluxes%bc(n)%ocean_restart_file
639 gas_fluxes%bc(n)%param => fm_util_get_real_array(
'param')
645 num_parameters = fm_util_get_integer(trim(flux_list) //
'implementation/' //&
646 & trim(gas_fluxes%bc(n)%implementation) //
'/num_parameters', scalar = .true.)
647 if (num_parameters .gt. 0)
then 648 if (.not.
associated(gas_fluxes%bc(n)%param))
then 649 write (error_string,
'(a,i2)')
': need ', num_parameters
650 call mpp_error(fatal, trim(error_header) //
' No param for ' // trim(name) // trim(error_string))
651 elseif (
size(gas_fluxes%bc(n)%param(:)) .ne. num_parameters)
then 652 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc(n)%param(:)),
' given, need ', num_parameters
653 call mpp_error(fatal, trim(error_header) //
' Wrong number of param for ' // trim(name) // trim(error_string))
655 elseif (num_parameters .eq. 0)
then 656 if (
associated(gas_fluxes%bc(n)%param))
then 657 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc(n)%param(:))
658 call mpp_error(fatal, trim(error_header) //
' No params needed for ' // trim(name) // trim(error_string))
661 write (error_string,
'(a,i2)')
': ', num_parameters
662 call mpp_error(fatal, trim(error_header) //
'Num_parameters is negative for ' // trim(name) // trim(error_string))
664 num_flags = fm_util_get_integer(trim(flux_list) //
'/num_flags', scalar = .true.)
665 if (num_flags .gt. 0)
then 666 if (.not.
associated(gas_fluxes%bc(n)%flag))
then 667 write (error_string,
'(a,i2)')
': need ', num_flags
668 call mpp_error(fatal, trim(error_header) //
' No flag for ' // trim(name) // trim(error_string))
669 elseif (
size(gas_fluxes%bc(n)%flag(:)) .ne. num_flags)
then 670 write (error_string,
'(a,i2,a,i2)')
': ',
size(gas_fluxes%bc(n)%flag(:)),
' given, need ', num_flags
671 call mpp_error(fatal, trim(error_header) //
' Wrong number of flag for ' // trim(name) // trim(error_string))
673 elseif (num_flags .eq. 0)
then 674 if (
associated(gas_fluxes%bc(n)%flag))
then 675 write (error_string,
'(a,i3)')
' but has size of ',
size(gas_fluxes%bc(n)%flag(:))
676 call mpp_error(fatal, trim(error_header) //
' No flags needed for ' // trim(name) // trim(error_string))
679 write (error_string,
'(a,i2)')
': ', num_flags
680 call mpp_error(fatal, trim(error_header) //
'Num_flags is negative for ' // trim(name) // trim(error_string))
684 gas_fluxes%bc(n)%use_atm_pressure =
fm_util_get_logical(trim(flux_list) //
'/use_atm_pressure')
685 gas_fields_atm%bc(n)%use_atm_pressure = gas_fluxes%bc(n)%use_atm_pressure
686 gas_fields_ice%bc(n)%use_atm_pressure = gas_fluxes%bc(n)%use_atm_pressure
688 gas_fluxes%bc(n)%use_10m_wind_speed =
fm_util_get_logical(trim(flux_list) //
'/use_10m_wind_speed')
689 gas_fields_atm%bc(n)%use_10m_wind_speed = gas_fluxes%bc(n)%use_10m_wind_speed
690 gas_fields_ice%bc(n)%use_10m_wind_speed = gas_fluxes%bc(n)%use_10m_wind_speed
692 gas_fluxes%bc(n)%pass_through_ice =
fm_util_get_logical(trim(flux_list) //
'/pass_through_ice')
693 gas_fields_atm%bc(n)%pass_through_ice = gas_fluxes%bc(n)%pass_through_ice
694 gas_fields_ice%bc(n)%pass_through_ice = gas_fluxes%bc(n)%pass_through_ice
698 if (verbose >= 5)
then 700 write (outunit,*)
'Dumping fluxes tracer tree' 701 if (.not. fm_dump_list(
'/coupler_mod/fluxes',
recursive = .true.))
then 702 call mpp_error(fatal, trim(error_header) //
' Problem dumping fluxes tracer tree')
709 total_fluxes = gas_fluxes%num_bcs
711 if (total_fluxes .ne. mpp_npes() * gas_fluxes%num_bcs)
then 712 write (string,
'(i4)') gas_fluxes%num_bcs
713 call mpp_error(fatal, trim(error_header) //&
714 &
' Number of fluxes does not match across the processors: ' // trim(string) //
' fluxes')
718 call fm_util_reset_no_overwrite
719 call fm_util_reset_caller
890 integer,
intent(in),
optional :: verbosity
894 character(len=*),
parameter :: sub_name =
'atmos_ocean_type_fluxes_init' 895 character(len=*),
parameter :: caller_str =&
896 & trim(mod_name) //
'(' // trim(sub_name) //
')' 897 character(len=*),
parameter :: error_header =&
898 &
'==>Error from ' // trim(
mod_name) //
'(' // trim(sub_name) //
'):' 899 logical,
save :: initialized = .false.
901 if (initialized)
return 904 if (
present(verbosity)) verbose = verbosity
908 call fm_util_set_no_overwrite(.true.)
909 call fm_util_set_caller(caller_str)
912 if (fm_new_list(
'/coupler_mod') .le. 0)
then 913 call mpp_error(fatal, trim(error_header) //
' Could not set the "coupler_mod" list')
916 if (fm_new_list(
'/coupler_mod/GOOD') .le. 0)
then 917 call mpp_error(fatal, trim(error_header) //
' Could not set the "GOOD" list')
919 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'GOOD', append = .true.)
921 if (fm_new_list(
'/coupler_mod/fluxes') .le. 0)
then 922 call mpp_error(fatal, trim(error_header) //
' Could not set the "/coupler_mod/fluxes" list')
924 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'fluxes', append = .true.)
926 if (fm_new_list(
'/coupler_mod/types') .le. 0)
then 927 call mpp_error(fatal, trim(error_header) //
' Could not set the "/coupler_mod/types" list')
929 call fm_util_set_value(
'/coupler_mod/GOOD/good_coupler_mod_list',
'types', append = .true.)
932 if (.not. fm_change_list(
'/coupler_mod/types'))
then 933 call mpp_error(fatal, trim(error_header) //
' Could not change to "/coupler_mod/types"')
938 if (fm_new_list(
'air_sea_gas_flux_generic') .le. 0)
then 939 call mpp_error(fatal, trim(error_header) //&
940 &
' Could not set the "air_sea_gas_flux_generic" list')
944 if (fm_new_list(
'air_sea_gas_flux_generic/implementation') .le. 0)
then 945 call mpp_error(fatal, trim(error_header) //&
946 &
' Could not set the "air_sea_gas_flux_generic/implementation" list')
950 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/ocmip2') .le. 0)
then 951 call mpp_error(fatal, trim(error_header) //&
952 &
' Could not set the "air_sea_gas_flux_generic/implementation/ocmip2" list')
954 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/ocmip2/num_parameters', 2)
956 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/duce') .le. 0)
then 957 call mpp_error(fatal, trim(error_header) //&
958 &
' Could not set the "air_sea_gas_flux_generic/implementation/duce" list')
960 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/duce/num_parameters', 1)
962 if (fm_new_list(
'air_sea_gas_flux_generic/implementation/johnson') .le. 0)
then 963 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/implementation/johnson" list')
965 call fm_util_set_value(
'air_sea_gas_flux_generic/implementation/johnson/num_parameters', 2)
974 if (fm_new_list(
'air_sea_gas_flux_generic/atm') .le. 0)
then 975 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/atm" list')
978 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'pcair', index = ind_pcair)
979 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Atmospheric concentration', index = ind_pcair)
980 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'mol/mol', index = ind_pcair)
982 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'u10', index = ind_u10)
983 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Wind speed at 10 m', index = ind_u10)
984 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'm/s', index = ind_u10)
986 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/name',
'psurf', index = ind_psurf)
987 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/long_name',
'Surface atmospheric pressure', index = ind_psurf)
988 call fm_util_set_value(
'air_sea_gas_flux_generic/atm/units',
'Pa', index = ind_psurf)
991 if (fm_new_list(
'air_sea_gas_flux_generic/ice') .le. 0)
then 992 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/ice" list')
995 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'alpha', index = ind_alpha)
996 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Solubility w.r.t. atmosphere', index = ind_alpha)
997 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'mol/m^3/atm', index = ind_alpha)
999 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'csurf', index = ind_csurf)
1000 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Ocean concentration', index = ind_csurf)
1001 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'mol/m^3', index = ind_csurf)
1003 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/name',
'sc_no', index = ind_sc_no)
1004 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/long_name',
'Schmidt number', index = ind_sc_no)
1005 call fm_util_set_value(
'air_sea_gas_flux_generic/ice/units',
'dimensionless', index = ind_sc_no)
1008 if (fm_new_list(
'air_sea_gas_flux_generic/flux') .le. 0)
then 1009 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux_generic/flux" list')
1029 if (fm_new_list(
'air_sea_gas_flux') .le. 0)
then 1030 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux" list')
1034 if (fm_new_list(
'air_sea_gas_flux/implementation') .le. 0)
then 1035 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation" list')
1039 if (fm_new_list(
'air_sea_gas_flux/implementation/ocmip2') .le. 0)
then 1040 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation/ocmip2" list')
1042 call fm_util_set_value(
'air_sea_gas_flux/implementation/ocmip2/num_parameters', 2)
1043 if (fm_new_list(
'air_sea_gas_flux/implementation/ocmip2_data') .le. 0)
then 1044 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation/ocmip2_data" list')
1046 call fm_util_set_value(
'air_sea_gas_flux/implementation/ocmip2_data/num_parameters', 2)
1047 if (fm_new_list(
'air_sea_gas_flux/implementation/linear') .le. 0)
then 1048 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/implementation/linear" list')
1050 call fm_util_set_value(
'air_sea_gas_flux/implementation/linear/num_parameters', 3)
1059 if (fm_new_list(
'air_sea_gas_flux/atm') .le. 0)
then 1060 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/atm" list')
1064 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Atmospheric concentration', index = ind_pcair)
1065 call fm_util_set_value(
'air_sea_gas_flux/atm/units',
'mol/mol', index = ind_pcair)
1068 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Wind speed at 10 m', index = ind_u10)
1072 call fm_util_set_value(
'air_sea_gas_flux/atm/long_name',
'Surface atmospheric pressure', index = ind_psurf)
1076 if (fm_new_list(
'air_sea_gas_flux/ice') .le. 0)
then 1077 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/ice" list')
1081 call fm_util_set_value(
'air_sea_gas_flux/ice/long_name',
'Solubility from atmosphere times Schmidt number term', index = ind_alpha)
1082 call fm_util_set_value(
'air_sea_gas_flux/ice/units',
'mol/m^3/atm', index = ind_alpha)
1085 call fm_util_set_value(
'air_sea_gas_flux/ice/long_name',
'Ocean concentration times Schmidt number term', index = ind_csurf)
1086 call fm_util_set_value(
'air_sea_gas_flux/ice/units',
'mol/m^3', index = ind_csurf)
1089 if (fm_new_list(
'air_sea_gas_flux/flux') .le. 0)
then 1090 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_gas_flux/flux" list')
1098 if (fm_new_list(
'air_sea_deposition') .le. 0)
then 1099 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition" list')
1103 if (fm_new_list(
'air_sea_deposition/implementation') .le. 0)
then 1104 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation" list')
1108 if (fm_new_list(
'air_sea_deposition/implementation/dry') .le. 0)
then 1109 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation/dry" list')
1111 call fm_util_set_value(
'air_sea_deposition/implementation/dry/num_parameters', 1)
1112 if (fm_new_list(
'air_sea_deposition/implementation/wet') .le. 0)
then 1113 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/implementation/wet" list')
1115 call fm_util_set_value(
'air_sea_deposition/implementation/wet/num_parameters', 1)
1124 if (fm_new_list(
'air_sea_deposition/atm') .le. 0)
then 1125 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/atm" list')
1128 call fm_util_set_value(
'air_sea_deposition/atm/name',
'deposition', index = ind_deposition)
1129 call fm_util_set_value(
'air_sea_deposition/atm/long_name',
'Atmospheric deposition', index = ind_deposition)
1130 call fm_util_set_value(
'air_sea_deposition/atm/units',
'kg/m^2/s', index = ind_deposition)
1133 if (fm_new_list(
'air_sea_deposition/ice') .le. 0)
then 1134 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/ice" list')
1142 if (fm_new_list(
'air_sea_deposition/flux') .le. 0)
then 1143 call mpp_error(fatal, trim(error_header) //
' Could not set the "air_sea_deposition/flux" list')
1151 if (fm_new_list(
'land_sea_runoff') .le. 0)
then 1152 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff" list')
1156 if (fm_new_list(
'land_sea_runoff/implementation') .le. 0)
then 1157 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/implementation" list')
1161 if (fm_new_list(
'land_sea_runoff/implementation/river') .le. 0)
then 1162 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/implementation/river" list')
1164 call fm_util_set_value(
'land_sea_runoff/implementation/river/num_parameters', 1)
1173 if (fm_new_list(
'land_sea_runoff/atm') .le. 0)
then 1174 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/atm" list')
1177 call fm_util_set_value(
'land_sea_runoff/atm/name',
'runoff', index = ind_runoff)
1178 call fm_util_set_value(
'land_sea_runoff/atm/long_name',
'Concentration in land runoff', index = ind_runoff)
1179 call fm_util_set_value(
'land_sea_runoff/atm/units',
'mol/m^3', index = ind_runoff)
1182 if (fm_new_list(
'land_sea_runoff/ice') .le. 0)
then 1183 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/ice" list')
1192 if (fm_new_list(
'land_sea_runoff/flux') .le. 0)
then 1193 call mpp_error(fatal, trim(error_header) //
' Could not set the "land_sea_runoff/flux" list')
1201 if (.not. fm_change_list(
'/'))
then 1202 call mpp_error(fatal, trim(error_header) //
' Could not change to "/"')
1206 call fm_util_reset_no_overwrite
1207 call fm_util_reset_caller
1210 if (verbose >= 5)
then 1213 write (outunit,*)
'Dumping coupler_mod/types tree' 1214 if (.not. fm_dump_list(
'/coupler_mod/types',
recursive = .true.))
then 1215 call mpp_error(fatal, trim(error_header) //
' Problem dumping /coupler_mod/types tree')
integer function, public fm_get_index(name)
integer, parameter, public fm_path_name_len
logical function, public fm_util_get_logical(name, caller, index, default_value, scalar)
subroutine, public fm_util_reset_no_overwrite
integer function, public fm_new_list(name, create, keep)
character(len=fm_string_len) function, public fm_util_get_string(name, caller, index, default_value, scalar)
integer, public ind_csurf
The index of the ocean surface concentration.
subroutine, public fm_util_set_no_overwrite(no_overwrite)
integer, parameter, public fm_string_len
integer, public ind_deposition
The index for the atmospheric deposition flux.
logical function, public fm_change_list(name)
integer, public ind_alpha
The index of the solubility array for a tracer.
integer function, public fm_util_get_length(name, caller)
integer, public ind_kw
The index for the piston velocity.
Ocean Carbon Model Intercomparison Study II: Gas exchange coupler. Implementation of routines to solv...
integer, public ind_sc_no
The index for the Schmidt number for a tracer flux.
integer, public ind_deltap
The index for ocean-air gas partial pressure change.
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 and return its index (0 on error)
integer, parameter, public fm_type_name_len
subroutine, public fm_util_check_for_bad_fields(list, good_fields, caller)
subroutine, public atmos_ocean_fluxes_init(gas_fluxes, gas_fields_atm, gas_fields_ice, verbosity)
Initialize gas flux structures.
integer, public ind_runoff
The index for a runoff flux.
subroutine, public atmos_ocean_type_fluxes_init(verbosity)
Initialize the coupler type flux tracers.
subroutine, public fm_util_set_good_name_list(good_name_list)
real function, public fm_util_get_real(name, caller, index, default_value, scalar)
integer, public ind_psurf
The index of the surface atmospheric pressure.
subroutine, public fm_util_set_caller(caller)
character(len= *), parameter mod_name
subroutine, public fm_util_reset_caller
logical function, public fm_dump_list(name, recursive, unit)
logical function, public fm_exists(name)
character(len=128), public fm_util_default_caller
integer, public ind_u10
The index of the 10 m wind speed.
subroutine, public fm_util_reset_good_name_list
integer function, public fm_util_get_integer(name, caller, index, default_value, scalar)
This module contains type declarations for the coupler.
character(len=fm_string_len) function, dimension(:), pointer, public fm_util_get_string_array(name, caller)
integer, public ind_pcair
The index of the atmospheric concentration.
real function, dimension(:), pointer, public fm_util_get_real_array(name, caller)
integer, public ind_flux0
The index for the piston velocity.
integer, public ind_flux
The index for the tracer flux.
character(len=fm_path_name_len) function, public fm_get_current_list()
integer, parameter, public fm_field_name_len
logical function, dimension(:), pointer, public fm_util_get_logical_array(name, caller)