diff --git a/atmos_model.F90 b/atmos_model.F90 index 5c54aed86..6725b1809 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -787,7 +787,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- Model should restart at the forecast hours that are multiples of fhzero. !--- WARNING: For special cases that model needs to restart at non-multiple of fhzero !--- the fields in first output files are not accumulated from the beginning of - !--- the bucket, but the restart time. + !--- the bucket, but the restart time. if (mod(sec,int(GFS_Control%fhzero*3600.)) /= 0) then diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys/3600.),int(GFS_Control%fhzero))*3600.0) if (mpp_pe() == mpp_root_pe()) print *,'Warning: in atmos_init,start at non multiple of fhzero' @@ -2840,7 +2840,7 @@ subroutine setup_exportdata(rc) integer :: isc, iec, jsc, jec integer :: nb, nk integer :: sphum, liq_wat, ice_wat, o3mr - real(GFS_kind_phys) :: rtime, rtimek + real(GFS_kind_phys) :: rtime, rtimek, spval integer :: localrc integer :: n,rank @@ -2853,7 +2853,8 @@ subroutine setup_exportdata(rc) !--- local parameters real(kind=ESMF_KIND_R8), parameter :: zeror8 = 0._ESMF_KIND_R8 - + real(GFS_kind_phys), parameter :: revap = one/2.501E+06_GFS_kind_phys ! reciprocal of specific + ! heat of vaporization J/kg !--- begin if (present(rc)) rc = ESMF_SUCCESS @@ -2865,6 +2866,7 @@ subroutine setup_exportdata(rc) rtime = one / GFS_control%dtp rtimek = GFS_control%rho_h2o * rtime + spval = GFS_control%huge do n=1, size(exportFields) @@ -2931,6 +2933,9 @@ subroutine setup_exportdata(rc) ! Instantaneous Latent heat flux (W/m**2) case ('inst_laten_heat_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, rc=localrc) + ! Instantaneous Evap flux (kg/m**2/s) + case ('inst_evap_rate') + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, revap, spval, rc=localrc) ! Instantaneous Downward long wave radiation flux (W/m**2) case ('inst_down_lw_flx') call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfci_cpl, Atm_block, nb, rc=localrc) @@ -2988,61 +2993,64 @@ subroutine setup_exportdata(rc) !--- Mean quantities ! MEAN Zonal compt of momentum flux (N/m**2) case ('mean_zonal_moment_flx_atm') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN Merid compt of momentum flux (N/m**2) case ('mean_merid_moment_flx_atm') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN Sensible heat flux (W/m**2) case ('mean_sensi_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN Latent heat flux (W/m**2) case ('mean_laten_heat_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) + ! MEAN Evap rate (kg/m**2/s) + case ('mean_evap_rate') + call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime*revap, rc=localrc) ! MEAN Downward LW heat flux (W/m**2) case ('mean_down_lw_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN Downward SW heat flux (W/m**2) case ('mean_down_sw_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dswsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dswsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET long wave radiation flux (W/m**2) case ('mean_net_lw_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nlwsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nlwsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET solar radiation flux over the ocean (W/m**2) case ('mean_net_sw_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nswsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nswsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN sfc downward nir direct flux (W/m**2) case ('mean_down_sw_ir_dir_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirbm_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN sfc downward nir diffused flux (W/m**2) case ('mean_down_sw_ir_dif_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN sfc downward uv+vis direct flux (W/m**2) case ('mean_down_sw_vis_dir_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisbm_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN sfc downward uv+vis diffused flux (W/m**2) case ('mean_down_sw_vis_dif_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET sfc nir direct flux (W/m**2) case ('mean_net_sw_ir_dir_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirbm_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET sfc nir diffused flux (W/m**2) case ('mean_net_sw_ir_dif_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET sfc uv+vis direct flux (W/m**2) case ('mean_net_sw_vis_dir_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisbm_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN NET sfc uv+vis diffused flux (W/m**2) case ('mean_net_sw_vis_dif_flx') - call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, rtime, spval, rc=localrc) ! MEAN precipitation rate (kg/m2/s) case ('mean_prec_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! MEAN convective precipitation rate (kg/m2/s) case ('mean_prec_rate_conv') - call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) + call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! MEAN snow precipitation rate (kg/m2/s) case ('mean_fprec_rate') - call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) + call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, rtimek, spval, rc=localrc) ! oceanfrac used by atm to calculate fluxes case ('openwater_frac_in_atm') call block_data_combine_fractions(datar82d, GFS_data(nb)%sfcprop%oceanfrac, GFS_Data(nb)%sfcprop%fice, Atm_block, nb, rc=localrc) diff --git a/cpl/module_block_data.F90 b/cpl/module_block_data.F90 index 1149bd252..7bd0a71b3 100644 --- a/cpl/module_block_data.F90 +++ b/cpl/module_block_data.F90 @@ -13,6 +13,7 @@ module module_block_data interface block_data_copy module procedure block_copy_1d_i4_to_2d_r8 module procedure block_copy_1d_r8_to_2d_r8 + module procedure block_copy_spval_1d_r8_to_2d_r8 module procedure block_copy_2d_r8_to_2d_r8 module procedure block_copy_2d_r8_to_3d_r8 module procedure block_copy_3d_r8_to_3d_r8 @@ -20,6 +21,7 @@ module module_block_data module procedure block_copy_1dslice2_r8_to_2d_r8 module procedure block_copy_3dslice_r8_to_3d_r8 module procedure block_copy_1d_r4_to_2d_r8 + module procedure block_copy_spval_1d_r4_to_2d_r8 module procedure block_copy_2d_r4_to_2d_r8 module procedure block_copy_2d_r4_to_3d_r8 module procedure block_copy_3d_r4_to_3d_r8 @@ -78,12 +80,12 @@ subroutine block_copy_1d_i4_to_2d_r8(destin_ptr, source_ptr, block, block_index, integer, pointer :: source_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -110,15 +112,15 @@ subroutine block_copy_1d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:) + real(kind=8), pointer :: source_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -138,25 +140,62 @@ subroutine block_copy_1d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, end if if (present(rc)) rc = localrc - + end subroutine block_copy_1d_r8_to_2d_r8 + subroutine block_copy_spval_1d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, special_value, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=8), pointer :: source_ptr(:) + type(block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=8), intent(in) :: scale_factor + real(kind=8), intent(in) :: special_value + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + !$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + if (source_ptr(ix) .ne. special_value) then + destin_ptr(i,j) = scale_factor * source_ptr(ix) + else + destin_ptr(i,j) = special_value + end if + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_spval_1d_r8_to_2d_r8 + ! -- copy: 1D slice to 2D subroutine block_copy_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -188,17 +227,17 @@ subroutine block_copy_1dslice2_r8_to_2d_r8(destin_ptr, source_ptr, slice1, slice ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:) integer, intent(in) :: slice1 integer, intent(in) :: slice2 type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -230,15 +269,15 @@ subroutine block_copy_2d_r8_to_3d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=8) :: factor ! -- begin @@ -269,15 +308,15 @@ subroutine block_copy_2d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=8) :: factor ! -- begin @@ -308,12 +347,12 @@ subroutine block_array_copy_2d_r8_to_2d_r8(destin_ptr, source_arr, block, block_ type (block_control_type), intent(in) :: block integer, intent(in) :: block_index real(kind=8), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=8) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -341,15 +380,15 @@ subroutine block_copy_3d_r8_to_3d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=8), pointer :: source_ptr(:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=8) :: factor ! -- begin @@ -381,13 +420,13 @@ subroutine block_array_copy_3d_r8_to_3d_r8(destin_ptr, source_arr, block, block_ real(kind=8), intent(in) :: source_arr(:,:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + real(kind=8), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k - real(kind=8) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -417,16 +456,16 @@ subroutine block_copy_3dslice_r8_to_3d_r8(destin_ptr, source_ptr, slice, block, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=8), pointer :: source_ptr(:,:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=8) :: factor ! -- begin @@ -462,13 +501,13 @@ subroutine block_array_copy_3dslice_r8_to_3d_r8(destin_ptr, source_arr, slice, b integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=8), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + real(kind=8), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k - real(kind=8) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -569,7 +608,7 @@ subroutine block_copy_or_fill_1d_r8_to_2d_r8(destin_ptr, source_ptr, fill_value, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:) + real(kind=8), pointer :: source_ptr(:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -594,7 +633,7 @@ subroutine block_copy_or_fill_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) integer, intent(in) :: slice real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block @@ -620,7 +659,7 @@ subroutine block_copy_or_fill_1dslice2_r8_to_2d_r8(destin_ptr, source_ptr, slice ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: source_ptr(:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:) integer, intent(in) :: slice1 integer, intent(in) :: slice2 real(ESMF_KIND_R8), intent(in) :: fill_value @@ -647,7 +686,7 @@ subroutine block_copy_or_fill_2d_r8_to_3d_r8(destin_ptr, source_ptr, fill_value, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=8), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -672,16 +711,15 @@ subroutine block_combine_frac_1d_r8_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=8), pointer :: fract1_ptr(:) - real(kind=8), pointer :: fract2_ptr(:) + real(kind=8), pointer :: fract1_ptr(:) + real(kind=8), pointer :: fract2_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=8) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -713,15 +751,15 @@ subroutine block_copy_1d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:) + real(kind=4), pointer :: source_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=4) :: factor ! -- begin @@ -744,22 +782,59 @@ subroutine block_copy_1d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, end subroutine block_copy_1d_r4_to_2d_r8 + subroutine block_copy_spval_1d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, special_value, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=4), pointer :: source_ptr(:) + type(block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), intent(in) :: scale_factor + real(kind=4), intent(in) :: special_value + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + !$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + if (source_ptr(ix) .ne. special_value) then + destin_ptr(i,j) = scale_factor * source_ptr(ix) + else + destin_ptr(i,j) = special_value + end if + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_spval_1d_r4_to_2d_r8 + ! -- copy: 1D slice to 2D subroutine block_copy_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=4) :: factor ! -- begin @@ -800,9 +875,9 @@ subroutine block_copy_1dslice2_r4_to_2d_r8(destin_ptr, source_ptr, slice1, slice integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -833,15 +908,15 @@ subroutine block_copy_2d_r4_to_3d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=4) :: factor ! -- begin @@ -872,15 +947,15 @@ subroutine block_copy_2d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb + integer :: localrc + integer :: i, ib, ix, j, jb real(kind=4) :: factor ! -- begin @@ -910,13 +985,13 @@ subroutine block_array_copy_2d_r4_to_2d_r8(destin_ptr, source_arr, block, block_ real(kind=4), intent(in) :: source_arr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -944,15 +1019,15 @@ subroutine block_copy_3d_r4_to_3d_r8(destin_ptr, source_ptr, block, block_index, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=4), pointer :: source_ptr(:,:,:) + real(kind=4), pointer :: source_ptr(:,:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=4) :: factor ! -- begin @@ -988,9 +1063,9 @@ subroutine block_array_copy_3d_r4_to_3d_r8(destin_ptr, source_arr, block, block_ integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -1020,16 +1095,16 @@ subroutine block_copy_3dslice_r4_to_3d_r8(destin_ptr, source_ptr, slice, block, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=4), pointer :: source_ptr(:,:,:,:) + real(kind=4), pointer :: source_ptr(:,:,:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor + real(kind=4), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k + integer :: localrc + integer :: i, ib, ix, j, jb, k real(kind=4) :: factor ! -- begin @@ -1065,13 +1140,13 @@ subroutine block_array_copy_3dslice_r4_to_3d_r8(destin_ptr, source_arr, slice, b integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind=4), optional, intent(in) :: scale_factor - integer, optional, intent(out) :: rc + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb, k - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -1104,7 +1179,7 @@ subroutine block_copy_or_fill_1d_r4_to_2d_r8(destin_ptr, source_ptr, fill_value, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:) + real(kind=4), pointer :: source_ptr(:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -1129,7 +1204,7 @@ subroutine block_copy_or_fill_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) integer, intent(in) :: slice real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block @@ -1182,7 +1257,7 @@ subroutine block_copy_or_fill_2d_r4_to_3d_r8(destin_ptr, source_ptr, fill_value, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind=4), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -1207,16 +1282,15 @@ subroutine block_combine_frac_1d_r4_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind=4), pointer :: fract1_ptr(:) - real(kind=4), pointer :: fract2_ptr(:) + real(kind=4), pointer :: fract1_ptr(:) + real(kind=4), pointer :: fract2_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index integer, optional, intent(out) :: rc ! -- local variables - integer :: localrc - integer :: i, ib, ix, j, jb - real(kind=4) :: factor + integer :: localrc + integer :: i, ib, ix, j, jb ! -- begin localrc = ESMF_RC_PTR_NOTALLOC diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 56eb372ad..884a3bdeb 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -26,7 +26,7 @@ module module_cplfields ! l : model levels (3D) ! s : surface (2D) ! t : tracers (4D) - integer, public, parameter :: NexportFields = 119 + integer, public, parameter :: NexportFields = 121 type(ESMF_Field), target, public :: exportFields(NexportFields) type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ & @@ -61,6 +61,7 @@ module module_cplfields FieldInfo("mean_merid_moment_flx_atm ", "s"), & FieldInfo("mean_sensi_heat_flx ", "s"), & FieldInfo("mean_laten_heat_flx ", "s"), & + FieldInfo("mean_evap_rate ", "s"), & FieldInfo("mean_down_lw_flx ", "s"), & FieldInfo("mean_down_sw_flx ", "s"), & FieldInfo("mean_prec_rate ", "s"), & @@ -68,6 +69,7 @@ module module_cplfields FieldInfo("inst_merid_moment_flx ", "s"), & FieldInfo("inst_sensi_heat_flx ", "s"), & FieldInfo("inst_laten_heat_flx ", "s"), & + FieldInfo("inst_evap_rate ", "s"), & FieldInfo("inst_down_lw_flx ", "s"), & FieldInfo("inst_down_sw_flx ", "s"), & FieldInfo("inst_temp_height2m ", "s"), &