FV3 Bundle
monin_obukhov_interfaces.h
Go to the documentation of this file.
1 ! -*-f90-*-
2 !#include <fms_platform.h>
3 
4 ! $Id$
5 
6  interface
7 
8  _PURE subroutine monin_obukhov_diff(vonkarm, &
9  & ustar_min, &
11  & ni, nj, nk, z, u_star, b_star, k_m, k_h, ier)
12 
13  real , intent(in ) :: vonkarm
14  real , intent(in ) :: ustar_min ! = 1.e-10
15  logical, intent(in ) :: neutral
16  integer, intent(in ) :: stable_option
17  logical, intent(in ) :: new_mo_option !miz
18  real , intent(in ) :: rich_crit, zeta_trans
19  integer, intent(in ) :: ni, nj, nk
20  real , intent(in ), dimension(ni, nj, nk) :: z
21  real , intent(in ), dimension(ni, nj) :: u_star, b_star
22  real , intent( out), dimension(ni, nj, nk) :: k_m, k_h
23  integer, intent( out) :: ier
24 
25  end subroutine monin_obukhov_diff
26 
27  _PURE subroutine monin_obukhov_drag_1d(grav, vonkarm, &
28  & error, zeta_min, max_iter, small, &
31  & n, pt, pt0, z, z0, zt, zq, speed, drag_m, drag_t, &
32  & drag_q, u_star, b_star, lavail, avail, ier)
33 
34  real , intent(in ) :: grav
35  real , intent(in ) :: vonkarm
36  real , intent(in ) :: error ! = 1.e-04
37  real , intent(in ) :: zeta_min ! = 1.e-06
38  integer, intent(in ) :: max_iter ! = 20
39  real , intent(in ) :: small ! = 1.e-04
40  logical, intent(in ) :: neutral
41  integer, intent(in ) :: stable_option
42  logical, intent(in ) :: new_mo_option !miz
43  real , intent(in ) :: rich_crit, zeta_trans
44  real , intent(in ) :: drag_min_heat,drag_min_moist,drag_min_mom
45  integer, intent(in ) :: n
46  real , intent(in ), dimension(n) :: pt ! potential temperature
47  real , intent(in ), dimension(n) :: pt0 ! reference potential temperature
48  real , intent(in ), dimension(n) :: z ! height above surface
49  real , intent(in ), dimension(n) :: z0 ! roughness height (height at which log wind profile is zero)
50  real , intent(in ), dimension(n) :: zt
51  real , intent(in ), dimension(n) :: zq
52  real , intent(in ), dimension(n) :: speed
53  real , intent(inout), dimension(n) :: drag_m
54  real , intent(inout), dimension(n) :: drag_t
55  real , intent(inout), dimension(n) :: drag_q
56  real , intent(inout), dimension(n) :: u_star
57  real , intent(inout), dimension(n) :: b_star
58  logical, intent(in ) :: lavail ! whether to use provided mask or not
59  logical, intent(in ), dimension(n) :: avail ! provided mask
60  integer, intent(out ) :: ier
61 
62  end subroutine monin_obukhov_drag_1d
63 
64  _PURE subroutine monin_obukhov_profile_1d(vonkarm, &
66  & n, zref, zref_t, z, z0, zt, zq, u_star, b_star, q_star, &
67  & del_m, del_t, del_q, lavail, avail, ier)
68 
69  real , intent(in ) :: vonkarm
70  logical, intent(in ) :: neutral
71  integer, intent(in ) :: stable_option
72  logical, intent(in ) :: new_mo_option !miz
73  real , intent(in ) :: rich_crit, zeta_trans
74  integer, intent(in ) :: n
75  real, intent(in) :: zref, zref_t
76  real, intent(in) , dimension(n) :: z, z0, zt, zq, u_star, b_star, q_star
77  real, intent(out), dimension(n) :: del_m, del_t, del_q
78  logical, intent(in) :: lavail ! whether to use provided mask or not
79  logical, intent(in) , dimension(n) :: avail ! provided mask
80  integer, intent( out) :: ier
81  end subroutine monin_obukhov_profile_1d
82 
83  _PURE subroutine monin_obukhov_derivative_t(stable_option, new_mo_option, rich_crit, zeta_trans, &
84  & n, phi_t, zeta, mask, ier)
85 
86  ! the differential similarity function for buoyancy and tracers
87  ! Note: seems to be the same as monin_obukhov_derivative_m?
88 
89  integer, intent(in ) :: stable_option
90  logical, intent(in ) :: new_mo_option !miz
91  real , intent(in ) :: rich_crit, zeta_trans
92  integer, intent(in ) :: n
93  real , intent( out), dimension(n) :: phi_t
94  real , intent(in ), dimension(n) :: zeta
95  logical, intent(in ), dimension(n) :: mask
96  integer, intent( out) :: ier
97  end subroutine monin_obukhov_derivative_t
98 
99  _PURE subroutine monin_obukhov_derivative_m(stable_option, rich_crit, zeta_trans, &
100  & n, phi_m, zeta, mask, ier)
101 
102  ! the differential similarity function for momentum
103 
104  integer, intent(in ) :: stable_option
105  real , intent(in ) :: rich_crit, zeta_trans
106  integer, intent(in ) :: n
107  real , intent( out), dimension(n) :: phi_m
108  real , intent(in ), dimension(n) :: zeta
109  logical, intent(in ), dimension(n) :: mask
110  integer, intent(out ) :: ier
111  end subroutine monin_obukhov_derivative_m
112 
113  _PURE subroutine monin_obukhov_integral_tq(stable_option, new_mo_option, rich_crit, zeta_trans, &
114  & n, psi_t, psi_q, zeta, zeta_t, zeta_q, &
115  & ln_z_zt, ln_z_zq, mask, ier)
116 
117  ! the integral similarity function for moisture and tracers
118 
119  integer, intent(in ) :: stable_option
120  logical, intent(in ) :: new_mo_option !miz
121  real, intent(in ) :: rich_crit, zeta_trans
122  integer, intent(in ) :: n
123  real , intent(inout), dimension(n) :: psi_t, psi_q
124  real , intent(in) , dimension(n) :: zeta, zeta_t, zeta_q, ln_z_zt, ln_z_zq
125  logical, intent(in) , dimension(n) :: mask
126  integer, intent( out) :: ier
127  end subroutine monin_obukhov_integral_tq
128 
129  _PURE subroutine monin_obukhov_integral_m(stable_option, rich_crit, zeta_trans, &
130  & n, psi_m, zeta, zeta_0, ln_z_z0, mask, ier)
131 
132  ! the integral similarity function for momentum
133 
134  integer, intent(in ) :: stable_option
135  real , intent(in ) :: rich_crit, zeta_trans
136  integer, intent(in ) :: n
137  real , intent(inout), dimension(n) :: psi_m
138  real , intent(in) , dimension(n) :: zeta, zeta_0, ln_z_z0
139  logical, intent(in) , dimension(n) :: mask
140  integer, intent(out) :: ier
141  end subroutine monin_obukhov_integral_m
142 
143  _PURE subroutine monin_obukhov_stable_mix(stable_option, rich_crit, zeta_trans, &
144  & n, rich, mix, ier)
145 
146  integer, intent(in ) :: stable_option
147  real , intent(in ) :: rich_crit, zeta_trans
148  integer, intent(in ) :: n
149  real , intent(in ), dimension(n) :: rich
150  real , intent( out), dimension(n) :: mix
151  integer, intent( out) :: ier
152  end subroutine monin_obukhov_stable_mix
153 
154  _PURE subroutine monin_obukhov_solve_zeta(error, zeta_min, max_iter, small, &
156  & n, rich, z, z0, zt, zq, f_m, f_t, f_q, mask, ier)
157 
158  real , intent(in ) :: error ! = 1.e-04
159  real , intent(in ) :: zeta_min ! = 1.e-06
160  integer, intent(in ) :: max_iter ! = 20
161  real , intent(in ) :: small ! = 1.e-04
162  integer, intent(in ) :: stable_option
163  logical, intent(in ) :: new_mo_option !miz
164  real , intent(in ) :: rich_crit, zeta_trans
165  integer, intent(in ) :: n
166  real , intent(in ), dimension(n) :: rich, z, z0, zt, zq
167  logical, intent(in ), dimension(n) :: mask
168  real , intent( out), dimension(n) :: f_m, f_t, f_q
169  integer, intent( out) :: ier
170  end subroutine monin_obukhov_solve_zeta
171 
172  end interface
real, parameter small
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::field3D(size(field, 1), size(field, 2), 1) MPP_TYPE_ ::wbuffer3D(size(wbuffer, 1), size(wbuffer, 2), 1) MPP_TYPE_ ::ebuffer3D(size(ebuffer, 1), size(ebuffer, 2), 1) MPP_TYPE_ ::sbuffer3D(size(sbuffer, 1), size(sbuffer, 2), 1) MPP_TYPE_ ::nbuffer3D(size(nbuffer, 1), size(nbuffer, 2), 1) pointer(ptr, field3D) pointer(ptr_w, wbuffer3D) pointer(ptr_e, ebuffer3D) pointer(ptr_s, sbuffer3D) pointer(ptr_n, nbuffer3D) ptr=LOC(field) ptr_w=LOC(wbuffer) ptr_e=LOC(ebuffer) ptr_s=LOC(sbuffer) ptr_n=LOC(nbuffer) call mpp_update_nest_fine(field3D, nest_domain, wbuffer3D, ebuffer3D, sbuffer3D, nbuffer3D, &flags, complete, position, extra_halo, name, tile_count) returnend subroutine MPP_UPDATE_NEST_FINE_2D_subroutine MPP_UPDATE_NEST_FINE_3D_(field, nest_domain, wbuffer, sbuffer, ebuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::d_type type(nestSpec), pointer ::update=> set_mismatch integer ::tile update_position nbuffersz l_size integer
real, parameter, public vonkarm
Von Karman constant [dimensionless].
Definition: constants.F90:131
integer, save, private nk
Definition: oda_core.F90:126
real(fp), dimension(2, n_play), parameter, public pt
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT end
*f90 *! $Id interface _PURE subroutine monin_obukhov_diff(vonkarm, &&ustar_min, &&neutral, stable_option, new_mo_option, rich_crit, zeta_trans, &!miz &ni, nj, nk, z, u_star, b_star, k_m, k_h, ier) real
real(double), parameter zero
real(fp), parameter, public e
l_size ! loop over number of fields ke do je do ie to is
#define _PURE
integer error
Definition: mpp.F90:1310
real, dimension(maxmts) height
real, parameter, public grav
Acceleration due to gravity [m/s^2].
Definition: constants.F90:76
type(tracer_type), dimension(max_tracer_fields), save tracers
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::field3D(size(field, 1), size(field, 2), 1) MPP_TYPE_ ::wbuffer3D(size(wbuffer, 1), size(wbuffer, 2), 1) MPP_TYPE_ ::ebuffer3D(size(ebuffer, 1), size(ebuffer, 2), 1) MPP_TYPE_ ::sbuffer3D(size(sbuffer, 1), size(sbuffer, 2), 1) MPP_TYPE_ ::nbuffer3D(size(nbuffer, 1), size(nbuffer, 2), 1) pointer(ptr, field3D) pointer(ptr_w, wbuffer3D) pointer(ptr_e, ebuffer3D) pointer(ptr_s, sbuffer3D) pointer(ptr_n, nbuffer3D) ptr=LOC(field) ptr_w=LOC(wbuffer) ptr_e=LOC(ebuffer) ptr_s=LOC(sbuffer) ptr_n=LOC(nbuffer) call mpp_update_nest_fine(field3D, nest_domain, wbuffer3D, ebuffer3D, sbuffer3D, nbuffer3D, &flags, complete, position, extra_halo, name, tile_count) returnend subroutine MPP_UPDATE_NEST_FINE_2D_subroutine MPP_UPDATE_NEST_FINE_3D_(field, nest_domain, wbuffer, sbuffer, ebuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::d_type type(nestSpec), pointer ::update=> dimension(MAX_DOMAIN_FIELDS)
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If not