static PetscErrorCode TSAdjointStep_RK(TS ts) { TS_RK *rk = (TS_RK*)ts->data; RKTableau tab = rk->tableau; const PetscInt s = tab->s; const PetscReal *A = tab->A,*b = tab->b,*c = tab->c; PetscScalar *w = rk->work; Vec *Y = rk->Y,*VecDeltaLam = rk->VecDeltaLam,*VecDeltaMu = rk->VecDeltaMu,*VecSensiTemp = rk->VecSensiTemp; PetscInt i,j,nadj; PetscReal t; PetscErrorCode ierr; PetscReal h = ts->time_step; Mat J,Jp; PetscFunctionBegin; t = ts->ptime; rk->status = TS_STEP_INCOMPLETE; h = ts->time_step; ierr = TSPreStep(ts);CHKERRQ(ierr); for (i=s-1; i>=0; i--) { rk->stage_time = t + h*(1.0-c[i]); for (nadj=0; nadj<ts->numcost; nadj++) { ierr = VecCopy(ts->vecs_sensi[nadj],VecSensiTemp[nadj]);CHKERRQ(ierr); ierr = VecScale(VecSensiTemp[nadj],-h*b[i]); for (j=i+1; j<s; j++) { ierr = VecAXPY(VecSensiTemp[nadj],-h*A[j*s+i],VecDeltaLam[nadj*s+j]); } } /* Stage values of lambda */ ierr = TSGetRHSJacobian(ts,&J,&Jp,NULL,NULL);CHKERRQ(ierr); ierr = TSComputeRHSJacobian(ts,rk->stage_time,Y[i],J,Jp);CHKERRQ(ierr); for (nadj=0; nadj<ts->numcost; nadj++) { ierr = MatMultTranspose(J,VecSensiTemp[nadj],VecDeltaLam[nadj*s+i]);CHKERRQ(ierr); } /* Stage values of mu */ if(ts->vecs_sensip) { ierr = TSAdjointComputeRHSJacobian(ts,rk->stage_time,Y[i],ts->Jacp);CHKERRQ(ierr); for (nadj=0; nadj<ts->numcost; nadj++) { ierr = MatMultTranspose(ts->Jacp,VecSensiTemp[nadj],VecDeltaMu[nadj*s+i]);CHKERRQ(ierr); } } } for (j=0; j<s; j++) w[j] = 1.0; for (nadj=0; nadj<ts->numcost; nadj++) { ierr = VecMAXPY(ts->vecs_sensi[nadj],s,w,&VecDeltaLam[nadj*s]);CHKERRQ(ierr); if(ts->vecs_sensip) { ierr = VecMAXPY(ts->vecs_sensip[nadj],s,w,&VecDeltaMu[nadj*s]);CHKERRQ(ierr); } } ts->ptime += ts->time_step; ts->steps++; rk->status = TS_STEP_COMPLETE; PetscFunctionReturn(0); }
PetscErrorCode RHSFunctionHeat(TS ts,PetscReal t,Vec globalin,Vec globalout,void *ctx) { PetscErrorCode ierr; Mat A; PetscFunctionBeginUser; ierr = TSGetRHSJacobian(ts,&A,NULL,NULL,&ctx);CHKERRQ(ierr); ierr = RHSMatrixHeat(ts,t,globalin,A,NULL,ctx);CHKERRQ(ierr); /* ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */ ierr = MatMult(A,globalin,globalout);CHKERRQ(ierr); PetscFunctionReturn(0); }