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...
 

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 3998 of file MOM_diag_mediator.F90.

3998  real, dimension(:,:), pointer :: field_in !< Original field to be down sampled
3999  real, dimension(:,:), allocatable :: field_out !< Down sampled field
4000  integer, intent(in) :: dl !< Level of down sampling
4001  integer, intent(in) :: method !< Sampling method
4002  real, dimension(:,:), pointer :: mask !< Mask for field
4003  type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output
4004  type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post
4005  integer, intent(in) :: isv_o !< Original i-start index
4006  integer, intent(in) :: jsv_o !< Original j-start index
4007  integer, intent(in) :: isv_d !< i-start index of down sampled data
4008  integer, intent(in) :: iev_d !< i-end index of down sampled data
4009  integer, intent(in) :: jsv_d !< j-start index of down sampled data
4010  integer, intent(in) :: jev_d !< j-end index of down sampled data
4011  ! Locals
4012  character(len=240) :: mesg
4013  integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2
4014  real :: ave,total_weight,weight
4015  real :: epsilon = 1.0e-20
4016 
4017  ! Allocate the down sampled field on the down sampled data domain
4018 ! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed))
4019 ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl))
4020  ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain
4021  f_in1 = size(field_in,1)
4022  f_in2 = size(field_in,2)
4023  f1 = f_in1/dl
4024  f2 = f_in2/dl
4025  ! Correction for the symmetric case
4026  if (diag_cs%G%symmetric) then
4027  f1 = f1 + mod(f_in1,dl)
4028  f2 = f2 + mod(f_in2,dl)
4029  endif
4030  allocate(field_out(1:f1,1:f2))
4031 
4032  if(method .eq. mmp) then
4033  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  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4039 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1
4040  weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj)
4041  total_weight = total_weight + weight
4042  ave=ave+field_in(ii,jj)*weight
4043  enddo; enddo
4044  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4045  enddo; enddo
4046  elseif(method .eq. ssp) then ! e.g., T_dfxy_cont_tendency_2d
4047  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  total_weight = 0.0
4052  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4053 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1
4054  weight = mask(ii,jj)
4055  total_weight = total_weight + weight
4056  ave=ave+field_in(ii,jj)*weight
4057  enddo; enddo
4058  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4059  enddo; enddo
4060  elseif(method .eq. psp) then ! e.g., umo_2d
4061  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4062  i0 = isv_o+dl*(i-isv_d)
4063  j0 = jsv_o+dl*(j-jsv_d)
4064  ave = 0.0
4065  total_weight = 0.0
4066  ii=i0
4067  do jj=j0,j0+dl-1
4068  weight =mask(ii,jj)
4069  total_weight = total_weight +weight
4070  ave=ave+field_in(ii,jj)*weight
4071  enddo
4072  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4073  enddo; enddo
4074  elseif(method .eq. spp) then ! e.g., vmo_2d
4075  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4076  i0 = isv_o+dl*(i-isv_d)
4077  j0 = jsv_o+dl*(j-jsv_d)
4078  ave = 0.0
4079  total_weight = 0.0
4080  jj=j0
4081  do ii=i0,i0+dl-1
4082  weight =mask(ii,jj)
4083  total_weight = total_weight +weight
4084  ave=ave+field_in(ii,jj)*weight
4085  enddo
4086  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4087  enddo; enddo
4088  elseif(method .eq. pmp) then
4089  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4090  i0 = isv_o+dl*(i-isv_d)
4091  j0 = jsv_o+dl*(j-jsv_d)
4092  ave = 0.0
4093  total_weight = 0.0
4094  ii=i0
4095  do jj=j0,j0+dl-1
4096  weight =mask(ii,jj)*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki?
4097  total_weight = total_weight +weight
4098  ave=ave+field_in(ii,jj)*weight
4099  enddo
4100  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4101  enddo; enddo
4102  elseif(method .eq. mpp) then
4103  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4104  i0 = isv_o+dl*(i-isv_d)
4105  j0 = jsv_o+dl*(j-jsv_d)
4106  ave = 0.0
4107  total_weight = 0.0
4108  jj=j0
4109  do ii=i0,i0+dl-1
4110  weight =mask(ii,jj)*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki?
4111  total_weight = total_weight +weight
4112  ave=ave+field_in(ii,jj)*weight
4113  enddo
4114  field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
4115  enddo; enddo
4116  elseif(method .eq. msk) then !The input field is a mask, subsample
4117  field_out(:,:) = 0.0
4118  do j=jsv_d,jev_d ; do i=isv_d,iev_d
4119  i0 = isv_o+dl*(i-isv_d)
4120  j0 = jsv_o+dl*(j-jsv_d)
4121  ave = 0.0
4122  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
4123  ave=ave+field_in(ii,jj)
4124  enddo; enddo
4125  if(ave > 0.0) field_out(i,j)=1.0
4126  enddo; enddo
4127  else
4128  write (mesg,*) " unknown sampling method: ",method
4129  call mom_error(fatal, "downsample_field_2d: "//trim(mesg)//" "//trim(diag%debug_str))
4130  endif
4131 

◆ 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 3827 of file MOM_diag_mediator.F90.

3827  real, dimension(:,:,:), pointer :: field_in !< Original field to be down sampled
3828  real, dimension(:,:,:), allocatable :: field_out !< down sampled field
3829  integer, intent(in) :: dl !< Level of down sampling
3830  integer, intent(in) :: method !< Sampling method
3831  real, dimension(:,:,:), pointer :: mask !< Mask for field
3832  type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output
3833  type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post
3834  integer, intent(in) :: isv_o !< Original i-start index
3835  integer, intent(in) :: jsv_o !< Original j-start index
3836  integer, intent(in) :: isv_d !< i-start index of down sampled data
3837  integer, intent(in) :: iev_d !< i-end index of down sampled data
3838  integer, intent(in) :: jsv_d !< j-start index of down sampled data
3839  integer, intent(in) :: jev_d !< j-end index of down sampled data
3840  ! Locals
3841  character(len=240) :: mesg
3842  integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2
3843  integer :: k,ks,ke
3844  real :: ave,total_weight,weight
3845  real :: epsilon = 1.0e-20
3846 
3847  ks=1 ; ke =size(field_in,3)
3848  ! Allocate the down sampled field on the down sampled data domain
3849 ! 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))
3850 ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl,ks:ke))
3851  f_in1 = size(field_in,1)
3852  f_in2 = size(field_in,2)
3853  f1 = f_in1/dl
3854  f2 = f_in2/dl
3855  !Correction for the symmetric case
3856  if (diag_cs%G%symmetric) then
3857  f1 = f1 + mod(f_in1,dl)
3858  f2 = f2 + mod(f_in2,dl)
3859  endif
3860  allocate(field_out(1:f1,1:f2,ks:ke))
3861 
3862  ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain
3863  if(method .eq. mmm) then
3864  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3865  i0 = isv_o+dl*(i-isv_d)
3866  j0 = jsv_o+dl*(j-jsv_d)
3867  ave = 0.0
3868  total_weight = 0.0
3869  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
3870 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!!
3871  weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k)
3872  total_weight = total_weight + weight
3873  ave=ave+field_in(ii,jj,k)*weight
3874  enddo; enddo
3875  field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
3876  enddo; enddo; enddo
3877  elseif(method .eq. sss) then !e.g., volcello
3878  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3879  i0 = isv_o+dl*(i-isv_d)
3880  j0 = jsv_o+dl*(j-jsv_d)
3881  ave = 0.0
3882  total_weight = 0.0
3883  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
3884 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1
3885  weight = mask(ii,jj,k)
3886  total_weight = total_weight + weight
3887  ave=ave+field_in(ii,jj,k)*weight
3888  enddo; enddo
3889  field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
3890  enddo; enddo; enddo
3891  elseif(method .eq. mmp .or. method .eq. mms) then !e.g., T_advection_xy
3892  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3893  i0 = isv_o+dl*(i-isv_d)
3894  j0 = jsv_o+dl*(j-jsv_d)
3895  ave = 0.0
3896  total_weight = 0.0
3897  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
3898 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1
3899  weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)
3900  total_weight = total_weight + weight
3901  ave=ave+field_in(ii,jj,k)*weight
3902  enddo; enddo
3903  field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
3904  enddo; enddo; enddo
3905  elseif(method .eq. pmm) then
3906  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3907  i0 = isv_o+dl*(i-isv_d)
3908  j0 = jsv_o+dl*(j-jsv_d)
3909  ave = 0.0
3910  total_weight = 0.0
3911  ii=i0
3912  do jj=j0,j0+dl-1
3913  weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k)
3914  total_weight = total_weight +weight
3915  ave=ave+field_in(ii,jj,k)*weight
3916  enddo
3917  field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
3918  enddo; enddo; enddo
3919  elseif(method .eq. psm) then
3920  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3921  i0 = isv_o+dl*(i-isv_d)
3922  j0 = jsv_o+dl*(j-jsv_d)
3923  ave = 0.0
3924  total_weight = 0.0
3925  ii=i0
3926  do jj=j0,j0+dl-1
3927  weight =mask(ii,jj,k)*diag_cs%h(ii,jj,k)
3928  total_weight = total_weight +weight
3929  ave=ave+field_in(ii,jj,k)*weight
3930  enddo
3931  field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
3932  enddo; enddo; enddo
3933  elseif(method .eq. pss) then !e.g. umo
3934  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3935  i0 = isv_o+dl*(i-isv_d)
3936  j0 = jsv_o+dl*(j-jsv_d)
3937  ave = 0.0
3938  total_weight = 0.0
3939  ii=i0
3940  do jj=j0,j0+dl-1
3941  weight =mask(ii,jj,k)
3942  total_weight = total_weight +weight
3943  ave=ave+field_in(ii,jj,k)*weight
3944  enddo
3945  field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
3946  enddo; enddo; enddo
3947  elseif(method .eq. sps) then !e.g. vmo
3948  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3949  i0 = isv_o+dl*(i-isv_d)
3950  j0 = jsv_o+dl*(j-jsv_d)
3951  ave = 0.0
3952  total_weight = 0.0
3953  jj=j0
3954  do ii=i0,i0+dl-1
3955  weight =mask(ii,jj,k)
3956  total_weight = total_weight +weight
3957  ave=ave+field_in(ii,jj,k)*weight
3958  enddo
3959  field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
3960  enddo; enddo; enddo
3961  elseif(method .eq. mpm) then
3962  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3963  i0 = isv_o+dl*(i-isv_d)
3964  j0 = jsv_o+dl*(j-jsv_d)
3965  ave = 0.0
3966  total_weight = 0.0
3967  jj=j0
3968  do ii=i0,i0+dl-1
3969  weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k)
3970  total_weight = total_weight + weight
3971  ave=ave+field_in(ii,jj,k)*weight
3972  enddo
3973  field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0
3974  enddo; enddo; enddo
3975  elseif(method .eq. msk) then !The input field is a mask, subsample
3976  field_out(:,:,:) = 0.0
3977  do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d
3978  i0 = isv_o+dl*(i-isv_d)
3979  j0 = jsv_o+dl*(j-jsv_d)
3980  ave = 0.0
3981  do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1
3982  ave=ave+field_in(ii,jj,k)
3983  enddo; enddo
3984  if(ave > 0.0) field_out(i,j,k)=1.0
3985  enddo; enddo; enddo
3986  else
3987  write (mesg,*) " unknown sampling method: ",method
3988  call mom_error(fatal, "downsample_field_3d: "//trim(mesg)//" "//trim(diag%debug_str))
3989  endif
3990 
The documentation for this interface was generated from the following file: