PetscErrorCode AssembleVelocityMatrix( UserContext *uc )
{
PetscErrorCode ierr;
PetscScalar val[5];
PetscReal z2 = PetscSqr( DELTA_Z ),
v = (2 * PetscSqr( DELTA_X ) + 4 * z2 ) / z2;
int i, j;
PetscFunctionBegin;
ierr = MatRetrieveValues(uc->A); CHKERRQ(ierr);
ierr = MatZeroEntries(uc->A); CHKERRQ(ierr);
Node *n;
for( i = 0; i < uc->numNodes; ++i)
{
n = &uc->nodes[i];
if( n->numNei == 4 )
{
for (j = 0; j < 4; ++j)
{
if(uc->nodes[n->nei[j]].numNei == 4)
{
val[j] = negone;
} else {
val[j] = zero;
}
}
val[4] = v;
ierr = MatSetValues(uc->A,1, &i, 5, n->nei, val, INSERT_VALUES); CHKERRQ(ierr);
} else {
ierr = MatSetValue(uc->A, i, i, one, INSERT_VALUES); CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(uc->A, MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(uc->A, MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
// ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF, PETSC_VIEWER_ASCII_DENSE); CHKERRQ(ierr);
// ierr = MatView(uc->A, PETSC_VIEWER_STDOUT_SELF); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat C,A;
PetscInt i, n = 10,midx[3],bs=1;
PetscErrorCode ierr;
PetscScalar v[3];
PetscBool flg,isAIJ;
MatType type;
PetscMPIInt size;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-mat_block_size",&bs,PETSC_NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetType(C,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatGetType(C,&type);CHKERRQ(ierr);
if (size == 1){
ierr = PetscObjectTypeCompare((PetscObject)C,MATSEQAIJ,&isAIJ);CHKERRQ(ierr);
} else {
ierr = PetscObjectTypeCompare((PetscObject)C,MATMPIAIJ,&isAIJ);CHKERRQ(ierr);
}
ierr = MatSeqAIJSetPreallocation(C,3,PETSC_NULL);
ierr = MatMPIAIJSetPreallocation(C,3,PETSC_NULL,3,PETSC_NULL);CHKERRQ(ierr);
ierr = MatSeqBAIJSetPreallocation(C,bs,3,PETSC_NULL);
ierr = MatMPIBAIJSetPreallocation(C,bs,3,PETSC_NULL,3,PETSC_NULL);CHKERRQ(ierr);
v[0] = -1.; v[1] = 2.; v[2] = -1.;
for (i=1; i<n-1; i++){
midx[2] = i-1; midx[1] = i; midx[0] = i+1;
ierr = MatSetValues(C,1,&i,3,midx,v,INSERT_VALUES);CHKERRQ(ierr);
}
i = 0; midx[0] = 0; midx[1] = 1;
v[0] = 2.0; v[1] = -1.;
ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr);
i = n-1; midx[0] = n-2; midx[1] = n-1;
v[0] = -1.0; v[1] = 2.;
ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* test matrices with different nonzero patterns - Note: A is created with different nonzero pattern of C! */
ierr = MatCopy(C,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatEqual(A,C,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"MatCopy(C,A,DIFFERENT_NONZERO_PATTERN): Matrices are NOT equal");
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"A is obtained with MatCopy(,,DIFFERENT_NONZERO_PATTERN):\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
/* test matrices with same nonzero pattern */
ierr = MatDuplicate(C,MAT_DO_NOT_COPY_VALUES,&A);CHKERRQ(ierr);
ierr = MatCopy(C,A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatEqual(A,C,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"MatCopy(C,A,SAME_NONZERO_PATTERN): Matrices are NOT equal");
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nA is obtained with MatCopy(,,SAME_NONZERO_PATTERN):\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"A:\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* test MatStore/RetrieveValues() */
if (isAIJ){
ierr = MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatStoreValues(A);CHKERRQ(ierr);
ierr = MatZeroEntries(A);CHKERRQ(ierr);
ierr = MatRetrieveValues(A);CHKERRQ(ierr);
}
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
double FormJf(Mode* ms, Geometry geo, Vec v, Vec f, double ftol, int printnewton){
Mode m = ms[0];
int lasing = m->lasing, Nm;
VecGetSize(v, &Nm); Nm /= NJ(geo);
Mat J = m->J; // for multimode, all m share same J
if(lasing)
ComputeGain(geo, ms, Nm); // do this before naming scratch vectors!
// ================== name scratch vectors ================== //
Vec vpsisq = geo->vscratch[3], // only form this later if needed
vIpsi = geo->vscratch[2];
Vec dfR, dfI;
if(Nm == 1){
dfR = geo->vscratch[0];
dfI = geo->vscratch[1];
}else{
dfR = geo->vNhscratch[0];
dfI = geo->vNhscratch[1];
}
// =========== linear J to compute residual ========= //
MatRetrieveValues(J);
int ih, jh, kh, ir, jr, jc;
for(ih=0; ih<Nm; ih++){
m = ms[ih];
VecSet(dfR, 0.0);
VecSet(dfI, 0.0);
LinearDerivative(m, geo, dfR, dfI, ih);
SetJacobian(geo, J, dfR, -2, 0, ih);
SetJacobian(geo, J, dfI, -2, 1, ih);
}
// row derivatives already added in add placeholders!
AssembleMat(J);
MatMult(J, v, f);
for(kh = 0; kh<Nm; kh++) for(ir=0; ir<2; ir++)
VecSetValue(f, kh*NJ(geo) + Nxyzcr(geo)+ir, 0.0, INSERT_VALUES);
// assume psi(ifix) = something + i 0. Note we do not explicitly assume what "something" is, so in principle psi can have any normalization, as long as Im psi(ifix) =0.
AssembleVec(f);
double fnorm;
VecNorm(f, NORM_2, &fnorm);
if( printnewton ) PetscPrintf(PETSC_COMM_WORLD, "|f| = %1.6e;", fnorm);
// no \n here to make room for timing printf statement immediately afterwards
if(Nm==2) //DEBUG
PetscPrintf(PETSC_COMM_WORLD, " DEBUG: |yw| c = (%g, %g)", get_c(ms[0]) / cabs(gamma_w(ms[0], geo)), get_c(ms[1]) / cabs(gamma_w(ms[1], geo)) );
// see note under "%s at D = %g:" print statement in Newton.c
if(fnorm < ftol )
return fnorm; // TODO: deleted old integral routine. Write new one here.
// =============== column derivatives ====================
for(jh=0; jh<Nm; jh++){
Mode mj = ms[jh];
VecSet(dfR, 0.0);
VecSet(dfI, 0.0);
if(Nm > 1) // hack: only recompute vpsisq if ComputeGain didn't already do it, i.e. for multimode
VecDotMedium(geo, mj->vpsi, mj->vpsi, vpsisq, geo->vMscratch[0]);
for(ih=0; ih<Nm; ih++){
Mode mi = ms[ih];
TimesI(geo, mi->vpsi, vIpsi);
ColumnDerivative(mi, mj, geo, dfR, dfI, vIpsi, vpsisq, ih);
}
SetJacobian(geo, J, dfR, -1, 0, jh);
SetJacobian(geo, J, dfI, -1, 1, jh);
}
//================ tensor derivatives ================
if(lasing){
Vec vpsibra = vpsisq; vpsisq = 0;
for(jh=0; jh<Nm; jh++){
Mode mj = ms[jh];
for(jr=0; jr<2; jr++) for(jc=0; jc< geo->gN.Nc; jc++){
VecCopy(mj->vpsi, vpsibra);
Stamp(geo, vpsibra, jc, jr, geo->vMscratch[0]);
VecSet(dfR, 0.0);
for(ih=0; ih<Nm; ih++){
Mode mi = ms[ih];
TimesI(geo, mi->vpsi, vIpsi);
TensorDerivative(mi, mj, geo, dfR, vpsibra, vIpsi, ih);
}
SetJacobian(geo, J, dfR, jc, jr, jh);
}
}
}
if(geo->interference != 0.0 && Nm == 2){
// column interference derivative
for(jh=0; jh<Nm; jh++){
Mode mj = ms[jh];
VecSet(dfR, 0.0);
VecSet(dfI, 0.0);
for(ih=0; ih<Nm; ih++){
Mode mi = ms[ih];
TimesI(geo, mi->vpsi, vIpsi);
// assume vscratch[6] computed above in ComputeGain
ColumnDerivative(mi, mj, geo, dfR, dfI, vIpsi, geo->vscratch[6], ih);
}
double thisc = get_c(mj), otherc = get_c(ms[1-jh]);
AssembleVec(dfI); // hack, so VecScale can work. Usually SetJacobian does the assembling
VecScale( dfI, otherc / thisc); // factor of two already included
AssembleVec(dfR);
// hack; this is usually called in SetJacobian, but here we are not setting the dfR part. If we don't assemble here, then ColumnDerivative will complain the next time we try to insert values into dfR.
SetJacobian(geo, J, dfI, -1, 1, jh);
}
// tensor interference derivative
for(jc=0; jc< geo->gN.Nc; jc++){ // shifted order of loops around for convenience, but this is actually unnecessary
Vec vpsibra = geo->vscratch[3],
vcos = geo->vscratch[4], vsin = geo->vscratch[5];
for(jh=0; jh<Nm; jh++) for(jr=0; jr<2; jr++) {
VecCopy( ms[1-jh]->vpsi, vcos);
Stamp(geo, vcos, jc, jr, geo->vMscratch[0]);
VecCopy( ms[1-jh]->vpsi, vsin);
Stamp(geo, vsin, jc, 1-jr, geo->vMscratch[0]);
//d/dE1R = cos E2R - sin E2I
//d/dE1I = cos E2I + sin E2R
//the other two are (1 <-> 2, sin <-> -sin)
double sign = (jh == jr ? -1.0 : 1.0);
double costh = cos(geo->interference), sinth = sin(geo->interference);
VecScale( vsin, sign * sinth);
VecWAXPY( vpsibra, costh, vcos, vsin); // this function has awkward syntax, and VecAXPBY is even worse
VecSet(dfR, 0.0);
for(ih=0; ih<Nm; ih++){
Mode mi = ms[ih];
TimesI(geo, mi->vpsi, vIpsi);
TensorDerivative(mi, ms[0], geo, dfR, vpsibra, vIpsi, ih);
} // will have factor of c[0]^2
double thisc = get_c(ms[0]), otherc = get_c(ms[1]);
AssembleVec(dfR); // same hack. see above
VecScale( dfR, otherc / thisc); // factor of two already included
SetJacobian(geo, J, dfR, jc, jr, jh);
}
}
PetscPrintf(PETSC_COMM_WORLD, "DEBUG: interference code called");
}
AssembleMat(J);
return fnorm;
}
