diff --git a/mpp/include/mpp_domains_misc.inc b/mpp/include/mpp_domains_misc.inc index 64c20ed386..e2ad028585 100644 --- a/mpp/include/mpp_domains_misc.inc +++ b/mpp/include/mpp_domains_misc.inc @@ -336,7 +336,6 @@ end subroutine init_nonblock_type ! Force use of "scalar", integer pointer mpp interface call mpp_send(ibounds(1), plen=4, to_pe=pelist2(1), tag=COMM_TAG_1) call mpp_send(send_buffer(1),plen=im*jm, to_pe=pelist2(1), tag=COMM_TAG_2) - deallocate(send_buffer) else if(pelist2(1) == pe) then ! receive data and compare do p = pelist1(1), pelist1(size(pelist1(:))) @@ -371,12 +370,13 @@ end subroutine init_nonblock_type print*, trim(mesg)//": ", 'comparison between 1 pe and ', npes-1, ' pes is ok' endif ! release memery - deallocate(field1, send_buffer) + deallocate(field1) endif deallocate(field2) call mpp_sync() + if (allocated(send_buffer)) deallocate(send_buffer) end subroutine mpp_check_field_2d_type1 diff --git a/mpp/include/mpp_util_mpi.inc b/mpp/include/mpp_util_mpi.inc index 2b1a28f37d..f94415c186 100644 --- a/mpp/include/mpp_util_mpi.inc +++ b/mpp/include/mpp_util_mpi.inc @@ -38,24 +38,24 @@ subroutine mpp_error_basic( errortype, errormsg ) #endif integer, intent(in) :: errortype character(len=*), intent(in), optional :: errormsg - character(len=512) :: text + character(len=512) :: text, text_errortype integer :: errunit if( .NOT.module_is_initialized )call ABORT() select case( errortype ) case(NOTE) - text = 'NOTE' !just FYI + text_errortype = 'NOTE' !just FYI case(WARNING) - text = 'WARNING' !probable error + text_errortype = 'WARNING' !probable error case(FATAL) - text = 'FATAL' !fatal error + text_errortype = 'FATAL' !fatal error case default - text = 'WARNING: non-existent errortype (must be NOTE|WARNING|FATAL)' + text_errortype = 'WARNING: non-existent errortype (must be NOTE|WARNING|FATAL)' end select - if( npes.GT.1 )write( text,'(a,i6)' )trim(text)//' from PE', pe !this is the mpp part - if( PRESENT(errormsg) )text = trim(text)//': '//trim(errormsg) + if( npes.GT.1 ) write( text,'(a,i6)' ) trim(text_errortype) // ' from PE', pe !this is the mpp part + if( PRESENT(errormsg) )text = trim(text) // ': ' // trim(errormsg) !$OMP CRITICAL (MPP_ERROR_CRITICAL) select case( errortype ) case(NOTE) diff --git a/test_fms/diag_manager/test_diag_update_buffer.F90 b/test_fms/diag_manager/test_diag_update_buffer.F90 index 1fff3f0d7f..21d211c23a 100644 --- a/test_fms/diag_manager/test_diag_update_buffer.F90 +++ b/test_fms/diag_manager/test_diag_update_buffer.F90 @@ -183,7 +183,7 @@ program test_diag_update_buffer diag_field_id = 1 sample = 1 weight = 1.0 - missvalue = 1.0e-5 + missvalue = 1.0e-5_r4_kind pow_value = 1 phys_window = .false. need_compute = .false. diff --git a/test_fms/exchange/test_xgrid.F90 b/test_fms/exchange/test_xgrid.F90 index f8a1eb2438..82841dd3c4 100644 --- a/test_fms/exchange/test_xgrid.F90 +++ b/test_fms/exchange/test_xgrid.F90 @@ -781,7 +781,8 @@ program xgrid_test subroutine test_unstruct_exchange() - real(r8_kind), allocatable :: atm_data_in(:,:), atm_data_sg(:,:) + real(r8_kind), allocatable :: atm_data_in_0(:,:), atm_data_in_1(:,:), atm_data_in_2(:,:), atm_data_in_3(:,:) + real(r8_kind), allocatable :: atm_data_sg(:,:) real(r8_kind), allocatable :: atm_data_sg_1(:,:), atm_data_sg_2(:,:), atm_data_sg_3(:,:) real(r8_kind), allocatable :: lnd_data_sg(:,:,:), ice_data_sg(:,:,:) real(r8_kind), allocatable :: atm_data_ug(:,:), tmp_sg(:,:,:) @@ -877,12 +878,18 @@ subroutine test_unstruct_exchange() allocate(atm_data_ug_2(isc_atm:iec_atm, jsc_atm:jec_atm ) ) allocate(atm_data_ug_3(isc_atm:iec_atm, jsc_atm:jec_atm ) ) - allocate(atm_data_in(isc_atm:iec_atm, jsc_atm:jec_atm ) ) + allocate(atm_data_in_0(isc_atm:iec_atm, jsc_atm:jec_atm ) ) + allocate(atm_data_in_1(isc_atm:iec_atm, jsc_atm:jec_atm ) ) + allocate(atm_data_in_2(isc_atm:iec_atm, jsc_atm:jec_atm ) ) + allocate(atm_data_in_3(isc_atm:iec_atm, jsc_atm:jec_atm ) ) allocate(atm_data_sg(isc_atm:iec_atm, jsc_atm:jec_atm ) ) allocate(atm_data_sg_1(isc_atm:iec_atm, jsc_atm:jec_atm ) ) allocate(atm_data_sg_2(isc_atm:iec_atm, jsc_atm:jec_atm ) ) allocate(atm_data_sg_3(isc_atm:iec_atm, jsc_atm:jec_atm ) ) - atm_data_in = 0 + atm_data_in_0 = 0 + atm_data_in_1 = 0 + atm_data_in_2 = 0 + atm_data_in_3 = 0 atm_data_sg = 0 atm_data_sg_1 = 0 atm_data_sg_2 = 0 @@ -914,11 +921,14 @@ subroutine test_unstruct_exchange() x_3 = 0 x_4 = 0 - call random_number(atm_data_in) - call put_to_xgrid(atm_data_in, 'ATM', x_1, Xmap, remap_method=remap_method) - call put_to_xgrid(atm_data_in+1, 'ATM', x_2, Xmap, remap_method=remap_method, complete=.false.) - call put_to_xgrid(atm_data_in+2, 'ATM', x_3, Xmap, remap_method=remap_method, complete=.false.) - call put_to_xgrid(atm_data_in+3, 'ATM', x_4, Xmap, remap_method=remap_method, complete=.true.) + call random_number(atm_data_in_0) + atm_data_in_1 = atm_data_in_0 + 1 + atm_data_in_2 = atm_data_in_0 + 2 + atm_data_in_3 = atm_data_in_0 + 3 + call put_to_xgrid(atm_data_in_0, 'ATM', x_1, Xmap, remap_method=remap_method) + call put_to_xgrid(atm_data_in_1, 'ATM', x_2, Xmap, remap_method=remap_method, complete=.false.) + call put_to_xgrid(atm_data_in_2, 'ATM', x_3, Xmap, remap_method=remap_method, complete=.false.) + call put_to_xgrid(atm_data_in_3, 'ATM', x_4, Xmap, remap_method=remap_method, complete=.true.) call get_from_xgrid(lnd_data_sg, 'LND', x_1, xmap) call get_from_xgrid(ice_data_sg, 'OCN', x_1, xmap) call put_to_xgrid(lnd_data_sg, 'LND', x_2, xmap) @@ -936,10 +946,10 @@ subroutine test_unstruct_exchange() y_3 = 0 y_4 = 0 - call put_to_xgrid(atm_data_in, 'ATM', y_1, Xmap_ug, remap_method=remap_method) - call put_to_xgrid(atm_data_in+1, 'ATM', y_2, Xmap_ug, remap_method=remap_method, complete=.false.) - call put_to_xgrid(atm_data_in+2, 'ATM', y_3, Xmap_ug, remap_method=remap_method, complete=.false.) - call put_to_xgrid(atm_data_in+3, 'ATM', y_4, Xmap_ug, remap_method=remap_method, complete=.true.) + call put_to_xgrid(atm_data_in_0, 'ATM', y_1, Xmap_ug, remap_method=remap_method) + call put_to_xgrid(atm_data_in_1, 'ATM', y_2, Xmap_ug, remap_method=remap_method, complete=.false.) + call put_to_xgrid(atm_data_in_2, 'ATM', y_3, Xmap_ug, remap_method=remap_method, complete=.false.) + call put_to_xgrid(atm_data_in_3, 'ATM', y_4, Xmap_ug, remap_method=remap_method, complete=.true.) call get_from_xgrid_ug(lnd_data_ug, 'LND', y_1, xmap_ug) call get_from_xgrid(ice_data_ug, 'OCN', y_1, xmap_ug) call put_to_xgrid_ug(lnd_data_ug, 'LND', y_2, xmap_ug) @@ -967,7 +977,8 @@ subroutine test_unstruct_exchange() if(ice_pe) deallocate(ice_data_sg, ice_data_ug) deallocate(tmp_sg, x_1, x_2, x_3, x_4, y_1, y_2, y_3, y_4) - deallocate(atm_data_in, atm_data_sg) + deallocate(atm_data_in_0, atm_data_in_1, atm_data_in_2, atm_data_in_3) + deallocate(atm_data_sg) deallocate(atm_data_sg_1, atm_data_sg_2, atm_data_sg_3) deallocate(atm_data_ug) deallocate(atm_data_ug_1, atm_data_ug_2, atm_data_ug_3)