1 2 #include <../src/vec/pf/pfimpl.h> /*I "petscpf.h" I*/ 3 4 static PetscErrorCode PFApply_Constant(void *value,PetscInt n,const PetscScalar *x,PetscScalar *y) 5 { 6 PetscInt i; 7 PetscScalar v = ((PetscScalar*)value)[0]; 8 9 PetscFunctionBegin; 10 n *= (PetscInt) PetscRealPart(((PetscScalar*)value)[1]); 11 for (i=0; i<n; i++) y[i] = v; 12 PetscFunctionReturn(0); 13 } 14 15 static PetscErrorCode PFApplyVec_Constant(void *value,Vec x,Vec y) 16 { 17 PetscErrorCode ierr; 18 19 PetscFunctionBegin; 20 ierr = VecSet(y,*((PetscScalar*)value));CHKERRQ(ierr); 21 PetscFunctionReturn(0); 22 } 23 PetscErrorCode PFView_Constant(void *value,PetscViewer viewer) 24 { 25 PetscErrorCode ierr; 26 PetscBool iascii; 27 28 PetscFunctionBegin; 29 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 30 if (iascii) { 31 #if !defined(PETSC_USE_COMPLEX) 32 ierr = PetscViewerASCIIPrintf(viewer,"Constant = %g\n",*(double*)value);CHKERRQ(ierr); 33 #else 34 ierr = PetscViewerASCIIPrintf(viewer,"Constant = %g + %gi\n",PetscRealPart(*(PetscScalar*)value),PetscImaginaryPart(*(PetscScalar*)value));CHKERRQ(ierr); 35 #endif 36 } 37 PetscFunctionReturn(0); 38 } 39 static PetscErrorCode PFDestroy_Constant(void *value) 40 { 41 PetscErrorCode ierr; 42 43 PetscFunctionBegin; 44 ierr = PetscFree(value);CHKERRQ(ierr); 45 PetscFunctionReturn(0); 46 } 47 48 static PetscErrorCode PFSetFromOptions_Constant(PetscOptionItems *PetscOptionsObject,PF pf) 49 { 50 PetscErrorCode ierr; 51 PetscScalar *value = (PetscScalar*)pf->data; 52 53 PetscFunctionBegin; 54 ierr = PetscOptionsHead(PetscOptionsObject,"Constant function options");CHKERRQ(ierr); 55 ierr = PetscOptionsScalar("-pf_constant","The constant value","None",*value,value,NULL);CHKERRQ(ierr); 56 ierr = PetscOptionsTail();CHKERRQ(ierr); 57 PetscFunctionReturn(0); 58 } 59 60 PETSC_EXTERN PetscErrorCode PFCreate_Constant(PF pf,void *value) 61 { 62 PetscErrorCode ierr; 63 PetscScalar *loc; 64 65 PetscFunctionBegin; 66 ierr = PetscMalloc1(2,&loc);CHKERRQ(ierr); 67 if (value) loc[0] = *(PetscScalar*)value; 68 else loc[0] = 0.0; 69 loc[1] = pf->dimout; 70 ierr = PFSet(pf,PFApply_Constant,PFApplyVec_Constant,PFView_Constant,PFDestroy_Constant,loc);CHKERRQ(ierr); 71 72 pf->ops->setfromoptions = PFSetFromOptions_Constant; 73 PetscFunctionReturn(0); 74 } 75 76 /*typedef PetscErrorCode (*FCN)(void*,PetscInt,const PetscScalar*,PetscScalar*); force argument to next function to not be extern C*/ 77 78 PETSC_EXTERN PetscErrorCode PFCreate_Quick(PF pf,PetscErrorCode (*function)(void*,PetscInt,const PetscScalar*,PetscScalar*)) 79 { 80 PetscErrorCode ierr; 81 82 PetscFunctionBegin; 83 ierr = PFSet(pf,function,NULL,NULL,NULL,NULL);CHKERRQ(ierr); 84 PetscFunctionReturn(0); 85 } 86 87 /* -------------------------------------------------------------------------------------------------------------------*/ 88 static PetscErrorCode PFApply_Identity(void *value,PetscInt n,const PetscScalar *x,PetscScalar *y) 89 { 90 PetscInt i; 91 92 PetscFunctionBegin; 93 n *= *(PetscInt*)value; 94 for (i=0; i<n; i++) y[i] = x[i]; 95 PetscFunctionReturn(0); 96 } 97 98 static PetscErrorCode PFApplyVec_Identity(void *value,Vec x,Vec y) 99 { 100 PetscErrorCode ierr; 101 102 PetscFunctionBegin; 103 ierr = VecCopy(x,y);CHKERRQ(ierr); 104 PetscFunctionReturn(0); 105 } 106 static PetscErrorCode PFView_Identity(void *value,PetscViewer viewer) 107 { 108 PetscErrorCode ierr; 109 PetscBool iascii; 110 111 PetscFunctionBegin; 112 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 113 if (iascii) { 114 ierr = PetscViewerASCIIPrintf(viewer,"Identity function\n");CHKERRQ(ierr); 115 } 116 PetscFunctionReturn(0); 117 } 118 static PetscErrorCode PFDestroy_Identity(void *value) 119 { 120 PetscErrorCode ierr; 121 122 PetscFunctionBegin; 123 ierr = PetscFree(value);CHKERRQ(ierr); 124 PetscFunctionReturn(0); 125 } 126 127 PETSC_EXTERN PetscErrorCode PFCreate_Identity(PF pf,void *value) 128 { 129 PetscErrorCode ierr; 130 PetscInt *loc; 131 132 PetscFunctionBegin; 133 if (pf->dimout != pf->dimin) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Input dimension must match output dimension for Identity function, dimin = %D dimout = %D\n",pf->dimin,pf->dimout); 134 ierr = PetscNew(&loc);CHKERRQ(ierr); 135 loc[0] = pf->dimout; 136 ierr = PFSet(pf,PFApply_Identity,PFApplyVec_Identity,PFView_Identity,PFDestroy_Identity,loc);CHKERRQ(ierr); 137 PetscFunctionReturn(0); 138 } 139