MOM6
Private functions | List of all members
mom_diag_mediator::downsample_field Interface Reference

Detailed Description

Down sample a field.

Definition at line 75 of file MOM_diag_mediator.F90.

Private functions

subroutine downsample_field_2d (field_in, field_out, dl, method, mask, diag_cs, diag, isv_o, jsv_o, isv_d, iev_d, jsv_d, jev_d)
 This subroutine allocates and computes a down sampled 2d array given an input array The down sample method is based on the "cell_methods" for the diagnostics as explained in the above table. More...
 
subroutine downsample_field_3d (field_in, field_out, dl, method, mask, diag_cs, diag, isv_o, jsv_o, isv_d, iev_d, jsv_d, jev_d)
 This subroutine allocates and computes a down sampled 3d array given an input array The down sample method is based on the "cell_methods" for the diagnostics as explained in the above table. More...
 

Detailed Description

Down sample a field.

Definition at line 75 of file MOM_diag_mediator.F90.

Functions and subroutines

◆ downsample_field_2d()

subroutine mom_diag_mediator::downsample_field::downsample_field_2d ( real, dimension(:,:), pointer  field_in,
real, dimension(:,:), allocatable  field_out,
integer, intent(in)  dl,
integer, intent(in)  method,
real, dimension(:,:), pointer  mask,
type(diag_ctrl), intent(in)  diag_cs,
type(diag_type), intent(in)  diag,
integer, intent(in)  isv_o,
integer, intent(in)  jsv_o,
integer, intent(in)  isv_d,
integer, intent(in)  iev_d,
integer, intent(in)  jsv_d,
integer, intent(in)  jev_d 
)
private

This subroutine allocates and computes a down sampled 2d array given an input array The down sample method is based on the "cell_methods" for the diagnostics as explained in the above table.

Parameters
field_inOriginal field to be down sampled
field_outDown sampled field
[in]dlLevel of down sampling
[in]methodSampling method
maskMask for field
[in]diag_csStructure used to regulate diagnostic output
[in]diagA structure describing the diagnostic to post
[in]isv_oOriginal i-start index
[in]jsv_oOriginal j-start index
[in]isv_di-start index of down sampled data
[in]iev_di-end index of down sampled data
[in]jsv_dj-start index of down sampled data
[in]jev_dj-end index of down sampled data

Definition at line 4107 of file MOM_diag_mediator.F90.

4107  real, dimension(:,:), pointer :: field_in !< Original field to be down sampled
4108  real, dimension(:,:), allocatable :: field_out !< Down sampled field
4109  integer, intent(in) :: dl !< Level of down sampling
4110  integer, intent(in) :: method !< Sampling method
4111  real, dimension(:,:), pointer :: mask !< Mask for field
4112  type(diag_ctrl), intent(in) :: diag_cs !< Structure used to regulate diagnostic output
4113  type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post
4114  integer, intent(in) :: isv_o !< Original i-start index
4115  integer, intent(in) :: jsv_o !< Original j-start index
4116  integer, intent(in) :: isv_d !< i-start index of down sampled data
4117  integer, intent(in) :: iev_d !< i-end index of down sampled data
4118  integer, intent(in) :: jsv_d !< j-start index of down sampled data
4119  integer, intent(in) :: jev_d !< j-end index of down sampled data
4120  ! Locals
4121  character(len=240) :: mesg
4122  integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2
4123  real :: ave, total_weight, weight
4124  real :: epsilon = 1.0e-20 ! A negligibly small count of weights [nondim]
4125  real :: eps_area ! A negligibly small area [L2 ~> m2]
4126  real :: eps_len ! A negligibly small horizontal length [L ~> m]
4127 
4128  eps_len = 1.0e-20 * diag_cs%G%US%m_to_L
4129  eps_area = 1.0e-20 * diag_cs%G%US%m_to_L**2
4130 
4131  ! Allocate the down sampled field on the down sampled data domain
4132 ! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed))
4133 ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl))
4134  ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain
4135  f_in1 = size(field_in,1)
4136  f_in2 = size(field_in,2)
4137  f1 = f_in1/dl
4138  f2 = f_in2/dl
4139  ! Correction for the symmetric case
4140  if (diag_cs%G%symmetric) then
4141  f1 = f1 + mod(f_in1,dl)
4142  f2 = f2 + mod(f_in2,dl)
4143  endif
4144  allocate(field_out(1:f1,1:f2))
4145 
4146  if (method == mmp) then
4147  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4148  i0 = isv_o+dl*(i-isv_d)
4149  j0 = jsv_o+dl*(j-jsv_d)
4150  ave = 0.0
4151  total_weight = 0.0
4152  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4153 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1
4154  weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj)
4155  total_weight = total_weight + weight
4156  ave = ave+field_in(ii,jj)*weight
4157  enddo; enddo
4158  field_out(i,j) = ave/(total_weight + eps_area) !Avoid zero mask at all aggregating cells where ave=0.0
4159  enddo; enddo
4160  elseif(method == ssp) then ! e.g., T_dfxy_cont_tendency_2d
4161  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4162  i0 = isv_o+dl*(i-isv_d)
4163  j0 = jsv_o+dl*(j-jsv_d)
4164  ave = 0.0
4165  total_weight = 0.0
4166  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4167 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1
4168  weight = mask(ii,jj)
4169  total_weight = total_weight + weight
4170  ave=ave+field_in(ii,jj)*weight
4171  enddo; enddo
4172  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4173  enddo; enddo
4174  elseif(method == psp) then ! e.g., umo_2d
4175  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4176  i0 = isv_o+dl*(i-isv_d)
4177  j0 = jsv_o+dl*(j-jsv_d)
4178  ave = 0.0
4179  total_weight = 0.0
4180  ii=i0
4181  do jj=j0,j0+dl-1
4182  weight = mask(ii,jj)
4183  total_weight = total_weight +weight
4184  ave=ave+field_in(ii,jj)*weight
4185  enddo
4186  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4187  enddo; enddo
4188  elseif(method == spp) then ! e.g., vmo_2d
4189  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4190  i0 = isv_o+dl*(i-isv_d)
4191  j0 = jsv_o+dl*(j-jsv_d)
4192  ave = 0.0
4193  total_weight = 0.0
4194  jj=j0
4195  do ii=i0,i0+dl-1
4196  weight = mask(ii,jj)
4197  total_weight = total_weight +weight
4198  ave=ave+field_in(ii,jj)*weight
4199  enddo
4200  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4201  enddo; enddo
4202  elseif(method == pmp) then
4203  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4204  i0 = isv_o+dl*(i-isv_d)
4205  j0 = jsv_o+dl*(j-jsv_d)
4206  ave = 0.0
4207  total_weight = 0.0
4208  ii=i0
4209  do jj=j0,j0+dl-1
4210  weight = mask(ii,jj) * diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki?
4211  total_weight = total_weight +weight
4212  ave=ave+field_in(ii,jj)*weight
4213  enddo
4214  field_out(i,j) = ave/(total_weight+eps_len) !Avoid zero mask at all aggregating cells where ave=0.0
4215  enddo; enddo
4216  elseif(method == mpp) then
4217  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4218  i0 = isv_o+dl*(i-isv_d)
4219  j0 = jsv_o+dl*(j-jsv_d)
4220  ave = 0.0
4221  total_weight = 0.0
4222  jj=j0
4223  do ii=i0,i0+dl-1
4224  weight = mask(ii,jj)* diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki?
4225  total_weight = total_weight +weight
4226  ave=ave+field_in(ii,jj)*weight
4227  enddo
4228  field_out(i,j) = ave/(total_weight+eps_len) !Avoid zero mask at all aggregating cells where ave=0.0
4229  enddo; enddo
4230  elseif(method == msk) then !The input field is a mask, subsample
4231  field_out(:,:) = 0.0
4232  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4233  i0 = isv_o+dl*(i-isv_d)
4234  j0 = jsv_o+dl*(j-jsv_d)
4235  ave = 0.0
4236  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4237  ave=ave+field_in(ii,jj)
4238  enddo; enddo
4239  if(ave > 0.0) field_out(i,j)=1.0
4240  enddo; enddo
4241  else
4242  write (mesg,*) " unknown sampling method: ",method
4243  call mom_error(fatal, "downsample_field_2d: "//trim(mesg)//" "//trim(diag%debug_str))
4244  endif
4245 

◆ downsample_field_3d()

subroutine mom_diag_mediator::downsample_field::downsample_field_3d ( real, dimension(:,:,:), pointer  field_in,
real, dimension(:,:,:), allocatable  field_out,
integer, intent(in)  dl,
integer, intent(in)  method,
real, dimension(:,:,:), pointer  mask,
type(diag_ctrl), intent(in)  diag_cs,
type(diag_type), intent(in)  diag,
integer, intent(in)  isv_o,
integer, intent(in)  jsv_o,
integer, intent(in)  isv_d,
integer, intent(in)  iev_d,
integer, intent(in)  jsv_d,
integer, intent(in)  jev_d 
)
private

This subroutine allocates and computes a down sampled 3d array given an input array The down sample method is based on the "cell_methods" for the diagnostics as explained in the above table.

The down sample algorithm

The down sample method could be deduced (before send_data call) from the diagx_cell_method, diagy_cell_method and diagv_cell_method

This is the summary of the down sample algoritm for a diagnostic field f:

\[ f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] \]

Here, i and j run from 0 to dl-1 (dl being the down sample level). Id,Jd are the down sampled (coarse grid) indices run over the coarsened compute grid, if and jf are the original (fine grid) indices.

 Example   x_cell y_cell v_cell algorithm_id    implemented weight(if,jf)
 ---------------------------------------------------------------------------------------
 theta     mean   mean   mean   MMM =222        G%areaT(if,jf)*h(if,jf)
 u         point  mean   mean   PMM =022        dyCu(if,jf)*h(if,jf)*delta(if,Id)
 v         mean   point  mean   MPM =202        dxCv(if,jf)*h(if,jf)*delta(jf,Jd)
 ?         point  sum    mean   PSM =012        h(if,jf)*delta(if,Id)
 volcello  sum    sum    sum    SSS =111        1
 T_dfxy_co sum    sum    point  SSP =110        1
 umo       point  sum    sum    PSS =011        1*delta(if,Id)
 vmo       sum    point  sum    SPS =101        1*delta(jf,Jd)
 umo_2d    point  sum    point  PSP =010        1*delta(if,Id)
 vmo_2d    sum    point  point  SPP =100        1*delta(jf,Jd)
 ?         point  mean   point  PMP =020        dyCu(if,jf)*delta(if,Id)
 ?         mean   point  point  MPP =200        dxCv(if,jf)*delta(jf,Jd)
 w         mean   mean   point  MMP =220        G%areaT(if,jf)
 h*theta   mean   mean   sum    MMS =221        G%areaT(if,jf)

 delta is the Kronecker delta
Parameters
field_inOriginal field to be down sampled
field_outdown sampled field
[in]dlLevel of down sampling
[in]methodSampling method
maskMask for field
[in]diag_csStructure used to regulate diagnostic output
[in]diagA structure describing the diagnostic to post
[in]isv_oOriginal i-start index
[in]jsv_oOriginal j-start index
[in]isv_di-start index of down sampled data
[in]iev_di-end index of down sampled data
[in]jsv_dj-start index of down sampled data
[in]jev_dj-end index of down sampled data

Definition at line 3951 of file MOM_diag_mediator.F90.

3951  real, dimension(:,:,:), pointer :: field_in !< Original field to be down sampled
3952  real, dimension(:,:,:), allocatable :: field_out !< down sampled field
3953  integer, intent(in) :: dl !< Level of down sampling
3954  integer, intent(in) :: method !< Sampling method
3955  real, dimension(:,:,:), pointer :: mask !< Mask for field
3956  type(diag_ctrl), intent(in) :: diag_cs !< Structure used to regulate diagnostic output
3957  type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post
3958  integer, intent(in) :: isv_o !< Original i-start index
3959  integer, intent(in) :: jsv_o !< Original j-start index
3960  integer, intent(in) :: isv_d !< i-start index of down sampled data
3961  integer, intent(in) :: iev_d !< i-end index of down sampled data
3962  integer, intent(in) :: jsv_d !< j-start index of down sampled data
3963  integer, intent(in) :: jev_d !< j-end index of down sampled data
3964  ! Locals
3965  character(len=240) :: mesg
3966  integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2
3967  integer :: k,ks,ke
3968  real :: ave,total_weight,weight
3969  real :: eps_vol ! A negligibly small volume or mass [H L2 ~> m3 or kg]
3970  real :: eps_area ! A negligibly small area [L2 ~> m2]
3971  real :: eps_face ! A negligibly small face area [H L ~> m2 or kg m-1]
3972 
3973  ks = 1 ; ke = size(field_in,3)
3974  eps_face = 1.0e-20 * diag_cs%G%US%m_to_L * diag_cs%GV%m_to_H
3975  eps_area = 1.0e-20 * diag_cs%G%US%m_to_L**2
3976  eps_vol = 1.0e-20 * diag_cs%G%US%m_to_L**2 * diag_cs%GV%m_to_H
3977 
3978  ! Allocate the down sampled field on the down sampled data domain
3979 ! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed,ks:ke))
3980 ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl,ks:ke))
3981  f_in1 = size(field_in,1)
3982  f_in2 = size(field_in,2)
3983  f1 = f_in1/dl
3984  f2 = f_in2/dl
3985  !Correction for the symmetric case
3986  if (diag_cs%G%symmetric) then
3987  f1 = f1 + mod(f_in1,dl)
3988  f2 = f2 + mod(f_in2,dl)
3989  endif
3990  allocate(field_out(1:f1,1:f2,ks:ke))
3991 
3992  ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain
3993  if (method == mmm) then
3994  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3995  i0 = isv_o+dl*(i-isv_d)
3996  j0 = jsv_o+dl*(j-jsv_d)
3997  ave = 0.0
3998  total_weight = 0.0
3999  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4000 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!!
4001  weight = mask(ii,jj,k) * diag_cs%G%areaT(ii,jj) * diag_cs%h(ii,jj,k)
4002  total_weight = total_weight + weight
4003  ave = ave+field_in(ii,jj,k) * weight
4004  enddo; enddo
4005  field_out(i,j,k) = ave/(total_weight + eps_vol) !Avoid zero mask at all aggregating cells where ave=0.0
4006  enddo; enddo; enddo
4007  elseif (method == sss) then !e.g., volcello
4008  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
4009  i0 = isv_o+dl*(i-isv_d)
4010  j0 = jsv_o+dl*(j-jsv_d)
4011  ave = 0.0
4012  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4013  weight = mask(ii,jj,k)
4014  ave = ave+field_in(ii,jj,k)*weight
4015  enddo; enddo
4016  field_out(i,j,k) = ave !Masked Sum (total_weight=1)
4017  enddo; enddo; enddo
4018  elseif(method == mmp .or. method == mms) then !e.g., T_advection_xy
4019  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
4020  i0 = isv_o+dl*(i-isv_d)
4021  j0 = jsv_o+dl*(j-jsv_d)
4022  ave = 0.0
4023  total_weight = 0.0
4024  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4025 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1
4026  weight = mask(ii,jj,k) * diag_cs%G%areaT(ii,jj)
4027  total_weight = total_weight + weight
4028  ave = ave+field_in(ii,jj,k)*weight
4029  enddo; enddo
4030  field_out(i,j,k) = ave / (total_weight+eps_area) !Avoid zero mask at all aggregating cells where ave=0.0
4031  enddo; enddo; enddo
4032  elseif(method == pmm) then
4033  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
4034  i0 = isv_o+dl*(i-isv_d)
4035  j0 = jsv_o+dl*(j-jsv_d)
4036  ave = 0.0
4037  total_weight = 0.0
4038  ii=i0
4039  do jj=j0,j0+dl-1
4040  weight =mask(ii,jj,k) * diag_cs%G%dyCu(ii,jj) * diag_cs%h(ii,jj,k)
4041  total_weight = total_weight +weight
4042  ave=ave+field_in(ii,jj,k)*weight
4043  enddo
4044  field_out(i,j,k) = ave/(total_weight+eps_face) !Avoid zero mask at all aggregating cells where ave=0.0
4045  enddo; enddo; enddo
4046  elseif(method == pss) then !e.g. umo
4047  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
4048  i0 = isv_o+dl*(i-isv_d)
4049  j0 = jsv_o+dl*(j-jsv_d)
4050  ave = 0.0
4051  ii=i0
4052  do jj=j0,j0+dl-1
4053  weight =mask(ii,jj,k)
4054  ave=ave+field_in(ii,jj,k)*weight
4055  enddo
4056  field_out(i,j,k) = ave !Masked Sum (total_weight=1)
4057  enddo; enddo; enddo
4058  elseif(method == sps) then !e.g. vmo
4059  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
4060  i0 = isv_o+dl*(i-isv_d)
4061  j0 = jsv_o+dl*(j-jsv_d)
4062  ave = 0.0
4063  jj=j0
4064  do ii=i0,i0+dl-1
4065  weight =mask(ii,jj,k)
4066  ave=ave+field_in(ii,jj,k)*weight
4067  enddo
4068  field_out(i,j,k) = ave !Masked Sum (total_weight=1)
4069  enddo; enddo; enddo
4070  elseif(method == mpm) then
4071  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
4072  i0 = isv_o+dl*(i-isv_d)
4073  j0 = jsv_o+dl*(j-jsv_d)
4074  ave = 0.0
4075  total_weight = 0.0
4076  jj=j0
4077  do ii=i0,i0+dl-1
4078  weight = mask(ii,jj,k) * diag_cs%G%dxCv(ii,jj) * diag_cs%h(ii,jj,k)
4079  total_weight = total_weight + weight
4080  ave=ave+field_in(ii,jj,k)*weight
4081  enddo
4082  field_out(i,j,k) = ave/(total_weight+eps_face) !Avoid zero mask at all aggregating cells where ave=0.0
4083  enddo; enddo; enddo
4084  elseif(method == msk) then !The input field is a mask, subsample
4085  field_out(:,:,:) = 0.0
4086  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
4087  i0 = isv_o+dl*(i-isv_d)
4088  j0 = jsv_o+dl*(j-jsv_d)
4089  ave = 0.0
4090  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4091  ave=ave+field_in(ii,jj,k)
4092  enddo; enddo
4093  if(ave > 0.0) field_out(i,j,k)=1.0
4094  enddo; enddo; enddo
4095  else
4096  write (mesg,*) " unknown sampling method: ",method
4097  call mom_error(fatal, "downsample_field_3d: "//trim(mesg)//" "//trim(diag%debug_str))
4098  endif
4099 
The documentation for this interface was generated from the following file: