FieldNegate Subroutine

public subroutine FieldNegate(field, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Field), intent(inout) :: field
integer, intent(out), optional :: rc

Calls

proc~~fieldnegate~~CallsGraph proc~fieldnegate FieldNegate esmf_fieldget esmf_fieldget proc~fieldnegate->esmf_fieldget interface~assign_fptr assign_fptr proc~fieldnegate->interface~assign_fptr interface~getfieldsundef GetFieldsUndef proc~fieldnegate->interface~getfieldsundef interface~mapl_assert MAPL_Assert proc~fieldnegate->interface~mapl_assert proc~fieldshaveundef FieldsHaveUndef proc~fieldnegate->proc~fieldshaveundef proc~mapl_return MAPL_Return proc~fieldnegate->proc~mapl_return proc~mapl_verify MAPL_Verify proc~fieldnegate->proc~mapl_verify proc~fieldshaveundef->proc~mapl_return proc~fieldshaveundef->proc~mapl_verify ESMF_AttributeGet ESMF_AttributeGet proc~fieldshaveundef->ESMF_AttributeGet at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception

Called by

proc~~fieldnegate~~CalledByGraph proc~fieldnegate FieldNegate proc~mapl_stateeval MAPL_StateEval proc~mapl_stateeval->proc~fieldnegate proc~test_fieldnegr4 test_FieldNegR4 proc~test_fieldnegr4->proc~fieldnegate none~evaluate_box_mask ExtDataMask%evaluate_box_mask none~evaluate_box_mask->proc~mapl_stateeval none~evaluate_region_mask ExtDataMask%evaluate_region_mask none~evaluate_region_mask->proc~mapl_stateeval none~evaluate_zone_mask ExtDataMask%evaluate_zone_mask none~evaluate_zone_mask->proc~mapl_stateeval proc~evaluate_derived_field DerivedExport%evaluate_derived_field proc~evaluate_derived_field->proc~mapl_stateeval none~evaluate_mask ExtDataMask%evaluate_mask proc~evaluate_derived_field->none~evaluate_mask none~evaluate_mask->none~evaluate_box_mask none~evaluate_mask->none~evaluate_region_mask none~evaluate_mask->none~evaluate_zone_mask

Source Code

subroutine FieldNegate(field,rc)
   type(ESMF_Field), intent(inout) :: field
   integer, intent(out), optional :: rc

   type(ESMF_TYPEKIND_FLAG) :: type_kind
   real(kind=ESMF_KIND_R4), pointer :: f_ptr_r4(:)
   real(kind=ESMF_KIND_R8), pointer :: f_ptr_r8(:)
   logical :: has_undef
   real(kind = ESMF_Kind_R4), allocatable :: undef_r4(:)
   real(kind = ESMF_Kind_R8), allocatable :: undef_r8(:) 
   integer :: status
   type(ESMF_Field) :: fields(1)


   fields(1) = field 
   has_undef = FieldsHaveUndef(fields,_RC)  
   call ESMF_FieldGet(field,typekind=type_kind,_RC)
   if (type_kind == ESMF_TYPEKIND_R4) then
      call assign_fptr(field,f_ptr_r4,_RC)
      if (has_undef) then
         call GetFieldsUndef(fields,undef_r4,_RC)
         where(f_ptr_r4 /= undef_r4(1))
            f_ptr_r4 = -f_ptr_r4
         end where
      else
         f_ptr_r4 = -f_ptr_r4
      end if
   else if (type_kind == ESMF_TYPEKIND_R4) then
      call assign_fptr(field,f_ptr_r8,_RC)
      if (has_undef) then
         call GetFieldsUndef(fields,undef_r8,_RC)
         where(f_ptr_r8 /= undef_r8(1))
            f_ptr_r8 = -f_ptr_r8
         end where
      else
         f_ptr_r8 = -f_ptr_r8
      end if
   else
      _FAIL('unsupported typekind')
   end if
   _RETURN(ESMF_SUCCESS)
end subroutine FieldNegate