1c4762a1bSJed Brown! Program usage: mpiexec -n <proc> plate2f [all TAO options] 2c4762a1bSJed Brown! 3c4762a1bSJed Brown! This example demonstrates use of the TAO package to solve a bound constrained 4c4762a1bSJed Brown! minimization problem. This example is based on a problem from the 5c4762a1bSJed Brown! MINPACK-2 test suite. Given a rectangular 2-D domain and boundary values 6c4762a1bSJed Brown! along the edges of the domain, the objective is to find the surface 7c4762a1bSJed Brown! with the minimal area that satisfies the boundary conditions. 8c4762a1bSJed Brown! The command line options are: 9c4762a1bSJed Brown! -mx <xg>, where <xg> = number of grid points in the 1st coordinate direction 10c4762a1bSJed Brown! -my <yg>, where <yg> = number of grid points in the 2nd coordinate direction 11c4762a1bSJed Brown! -bmx <bxg>, where <bxg> = number of grid points under plate in 1st direction 12c4762a1bSJed Brown! -bmy <byg>, where <byg> = number of grid points under plate in 2nd direction 13c4762a1bSJed Brown! -bheight <ht>, where <ht> = height of the plate 14c4762a1bSJed Brown! 15c4762a1bSJed Brown 1677d968b7SBarry Smith module plate2fmodule 17c4762a1bSJed Brown#include "petsc/finclude/petscdmda.h" 18c4762a1bSJed Brown#include "petsc/finclude/petsctao.h" 19c4762a1bSJed Brown use petscdmda 20c4762a1bSJed Brown use petsctao 21c4762a1bSJed Brown 22c4762a1bSJed Brown Vec localX, localV 23c4762a1bSJed Brown Vec Top, Left 24c4762a1bSJed Brown Vec Right, Bottom 25c4762a1bSJed Brown DM dm 26c4762a1bSJed Brown PetscReal bheight 27c4762a1bSJed Brown PetscInt bmx, bmy 28c4762a1bSJed Brown PetscInt mx, my, Nx, Ny, N 29c4762a1bSJed Brown end module 30c4762a1bSJed Brown 31c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 32c4762a1bSJed Brown! Variable declarations 33c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 34c4762a1bSJed Brown! 35c4762a1bSJed Brown! Variables: 36c4762a1bSJed Brown! (common from plate2f.h): 37c4762a1bSJed Brown! Nx, Ny number of processors in x- and y- directions 38c4762a1bSJed Brown! mx, my number of grid points in x,y directions 39c4762a1bSJed Brown! N global dimension of vector 4077d968b7SBarry Smith use plate2fmodule 41c4762a1bSJed Brown implicit none 42c4762a1bSJed Brown 43c4762a1bSJed Brown PetscErrorCode ierr ! used to check for functions returning nonzeros 44c4762a1bSJed Brown Vec x ! solution vector 45c4762a1bSJed Brown PetscInt m ! number of local elements in vector 46c4762a1bSJed Brown Tao tao ! Tao solver context 47c4762a1bSJed Brown Mat H ! Hessian matrix 48c4762a1bSJed Brown ISLocalToGlobalMapping isltog ! local to global mapping object 49c4762a1bSJed Brown PetscBool flg 50c4762a1bSJed Brown PetscInt i1,i3,i7 51c4762a1bSJed Brown 52c4762a1bSJed Brown external FormFunctionGradient 53c4762a1bSJed Brown external FormHessian 54c4762a1bSJed Brown external MSA_BoundaryConditions 55c4762a1bSJed Brown external MSA_Plate 56c4762a1bSJed Brown external MSA_InitialPoint 57c4762a1bSJed Brown! Initialize Tao 58c4762a1bSJed Brown 59c4762a1bSJed Brown i1=1 60c4762a1bSJed Brown i3=3 61c4762a1bSJed Brown i7=7 62c4762a1bSJed Brown 63d8606c27SBarry Smith PetscCallA(PetscInitialize(ierr)) 64c4762a1bSJed Brown 65c4762a1bSJed Brown! Specify default dimensions of the problem 66c4762a1bSJed Brown mx = 10 67c4762a1bSJed Brown my = 10 68c4762a1bSJed Brown bheight = 0.1 69c4762a1bSJed Brown 70c4762a1bSJed Brown! Check for any command line arguments that override defaults 71c4762a1bSJed Brown 72d8606c27SBarry Smith PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-mx',mx,flg,ierr)) 73d8606c27SBarry Smith PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-my',my,flg,ierr)) 74c4762a1bSJed Brown 75c4762a1bSJed Brown bmx = mx/2 76c4762a1bSJed Brown bmy = my/2 77c4762a1bSJed Brown 78d8606c27SBarry Smith PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-bmx',bmx,flg,ierr)) 79d8606c27SBarry Smith PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-bmy',bmy,flg,ierr)) 80d8606c27SBarry Smith PetscCallA(PetscOptionsGetReal(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-bheight',bheight,flg,ierr)) 81c4762a1bSJed Brown 82c4762a1bSJed Brown! Calculate any derived values from parameters 83c4762a1bSJed Brown N = mx*my 84c4762a1bSJed Brown 85c4762a1bSJed Brown! Let Petsc determine the dimensions of the local vectors 86c4762a1bSJed Brown Nx = PETSC_DECIDE 87c4762a1bSJed Brown NY = PETSC_DECIDE 88c4762a1bSJed Brown 89c4762a1bSJed Brown! A two dimensional distributed array will help define this problem, which 90c4762a1bSJed Brown! derives from an elliptic PDE on a two-dimensional domain. From the 91c4762a1bSJed Brown! distributed array, create the vectors 92c4762a1bSJed Brown 93d8606c27SBarry Smith PetscCallA(DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE, DMDA_STENCIL_BOX,mx,my,Nx,Ny,i1,i1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,dm,ierr)) 94d8606c27SBarry Smith PetscCallA(DMSetFromOptions(dm,ierr)) 95d8606c27SBarry Smith PetscCallA(DMSetUp(dm,ierr)) 96c4762a1bSJed Brown 97c4762a1bSJed Brown! Extract global and local vectors from DM; The local vectors are 98c4762a1bSJed Brown! used solely as work space for the evaluation of the function, 99c4762a1bSJed Brown! gradient, and Hessian. Duplicate for remaining vectors that are 100c4762a1bSJed Brown! the same types. 101c4762a1bSJed Brown 102d8606c27SBarry Smith PetscCallA(DMCreateGlobalVector(dm,x,ierr)) 103d8606c27SBarry Smith PetscCallA(DMCreateLocalVector(dm,localX,ierr)) 104d8606c27SBarry Smith PetscCallA(VecDuplicate(localX,localV,ierr)) 105c4762a1bSJed Brown 106c4762a1bSJed Brown! Create a matrix data structure to store the Hessian. 107c4762a1bSJed Brown! Here we (optionally) also associate the local numbering scheme 108c4762a1bSJed Brown! with the matrix so that later we can use local indices for matrix 109c4762a1bSJed Brown! assembly 110c4762a1bSJed Brown 111d8606c27SBarry Smith PetscCallA(VecGetLocalSize(x,m,ierr)) 112d8606c27SBarry Smith PetscCallA(MatCreateAIJ(PETSC_COMM_WORLD,m,m,N,N,i7,PETSC_NULL_INTEGER,i3,PETSC_NULL_INTEGER,H,ierr)) 113c4762a1bSJed Brown 114d8606c27SBarry Smith PetscCallA(MatSetOption(H,MAT_SYMMETRIC,PETSC_TRUE,ierr)) 115d8606c27SBarry Smith PetscCallA(DMGetLocalToGlobalMapping(dm,isltog,ierr)) 116d8606c27SBarry Smith PetscCallA(MatSetLocalToGlobalMapping(H,isltog,isltog,ierr)) 117c4762a1bSJed Brown 118c4762a1bSJed Brown! The Tao code begins here 119c4762a1bSJed Brown! Create TAO solver and set desired solution method. 120c4762a1bSJed Brown! This problems uses bounded variables, so the 121c4762a1bSJed Brown! method must either be 'tao_tron' or 'tao_blmvm' 122c4762a1bSJed Brown 123d8606c27SBarry Smith PetscCallA(TaoCreate(PETSC_COMM_WORLD,tao,ierr)) 124d8606c27SBarry Smith PetscCallA(TaoSetType(tao,TAOBLMVM,ierr)) 125c4762a1bSJed Brown 126c4762a1bSJed Brown! Set minimization function and gradient, hessian evaluation functions 127c4762a1bSJed Brown 128d8606c27SBarry Smith PetscCallA(TaoSetObjectiveAndGradient(tao,PETSC_NULL_VEC,FormFunctionGradient,0,ierr)) 129c4762a1bSJed Brown 130d8606c27SBarry Smith PetscCallA(TaoSetHessian(tao,H,H,FormHessian,0, ierr)) 131c4762a1bSJed Brown 132c4762a1bSJed Brown! Set Variable bounds 133d8606c27SBarry Smith PetscCallA(MSA_BoundaryConditions(ierr)) 134d8606c27SBarry Smith PetscCallA(TaoSetVariableBoundsRoutine(tao,MSA_Plate,0,ierr)) 135c4762a1bSJed Brown 136c4762a1bSJed Brown! Set the initial solution guess 137d8606c27SBarry Smith PetscCallA(MSA_InitialPoint(x, ierr)) 138d8606c27SBarry Smith PetscCallA(TaoSetSolution(tao,x,ierr)) 139c4762a1bSJed Brown 140c4762a1bSJed Brown! Check for any tao command line options 141d8606c27SBarry Smith PetscCallA(TaoSetFromOptions(tao,ierr)) 142c4762a1bSJed Brown 143c4762a1bSJed Brown! Solve the application 144d8606c27SBarry Smith PetscCallA(TaoSolve(tao,ierr)) 145c4762a1bSJed Brown 146c4762a1bSJed Brown! Free TAO data structures 147d8606c27SBarry Smith PetscCallA(TaoDestroy(tao,ierr)) 148c4762a1bSJed Brown 149c4762a1bSJed Brown! Free PETSc data structures 150d8606c27SBarry Smith PetscCallA(VecDestroy(x,ierr)) 151d8606c27SBarry Smith PetscCallA(VecDestroy(Top,ierr)) 152d8606c27SBarry Smith PetscCallA(VecDestroy(Bottom,ierr)) 153d8606c27SBarry Smith PetscCallA(VecDestroy(Left,ierr)) 154d8606c27SBarry Smith PetscCallA(VecDestroy(Right,ierr)) 155d8606c27SBarry Smith PetscCallA(MatDestroy(H,ierr)) 156d8606c27SBarry Smith PetscCallA(VecDestroy(localX,ierr)) 157d8606c27SBarry Smith PetscCallA(VecDestroy(localV,ierr)) 158d8606c27SBarry Smith PetscCallA(DMDestroy(dm,ierr)) 159c4762a1bSJed Brown 160c4762a1bSJed Brown! Finalize TAO 161c4762a1bSJed Brown 162d8606c27SBarry Smith PetscCallA(PetscFinalize(ierr)) 163c4762a1bSJed Brown 164c4762a1bSJed Brown end 165c4762a1bSJed Brown 166c4762a1bSJed Brown! --------------------------------------------------------------------- 167c4762a1bSJed Brown! 168c4762a1bSJed Brown! FormFunctionGradient - Evaluates function f(X). 169c4762a1bSJed Brown! 170c4762a1bSJed Brown! Input Parameters: 171c4762a1bSJed Brown! tao - the Tao context 172c4762a1bSJed Brown! X - the input vector 173c4762a1bSJed Brown! dummy - optional user-defined context, as set by TaoSetFunction() 174c4762a1bSJed Brown! (not used here) 175c4762a1bSJed Brown! 176c4762a1bSJed Brown! Output Parameters: 177c4762a1bSJed Brown! fcn - the newly evaluated function 178c4762a1bSJed Brown! G - the gradient vector 179c4762a1bSJed Brown! info - error code 180c4762a1bSJed Brown! 181c4762a1bSJed Brown 182c4762a1bSJed Brown subroutine FormFunctionGradient(tao,X,fcn,G,dummy,ierr) 18377d968b7SBarry Smith use plate2fmodule 184c4762a1bSJed Brown implicit none 185c4762a1bSJed Brown 186c4762a1bSJed Brown! Input/output variables 187c4762a1bSJed Brown 188c4762a1bSJed Brown Tao tao 189c4762a1bSJed Brown PetscReal fcn 190c4762a1bSJed Brown Vec X, G 191c4762a1bSJed Brown PetscErrorCode ierr 192c4762a1bSJed Brown PetscInt dummy 193c4762a1bSJed Brown 194c4762a1bSJed Brown PetscInt i,j,row 195c4762a1bSJed Brown PetscInt xs, xm 196c4762a1bSJed Brown PetscInt gxs, gxm 197c4762a1bSJed Brown PetscInt ys, ym 198c4762a1bSJed Brown PetscInt gys, gym 199c4762a1bSJed Brown PetscReal ft,zero,hx,hy,hydhx,hxdhy 200c4762a1bSJed Brown PetscReal area,rhx,rhy 201c4762a1bSJed Brown PetscReal f1,f2,f3,f4,f5,f6,d1,d2,d3 202c4762a1bSJed Brown PetscReal d4,d5,d6,d7,d8 203c4762a1bSJed Brown PetscReal df1dxc,df2dxc,df3dxc,df4dxc 204c4762a1bSJed Brown PetscReal df5dxc,df6dxc 205c4762a1bSJed Brown PetscReal xc,xl,xr,xt,xb,xlt,xrb 206c4762a1bSJed Brown 207*42ce371bSBarry Smith PetscReal, pointer :: g_v(:),x_v(:) 208*42ce371bSBarry Smith PetscReal, pointer :: top_v(:),left_v(:) 209*42ce371bSBarry Smith PetscReal, pointer :: right_v(:),bottom_v(:) 210c4762a1bSJed Brown 211c4762a1bSJed Brown ft = 0.0 212c4762a1bSJed Brown zero = 0.0 213c4762a1bSJed Brown hx = 1.0/real(mx + 1) 214c4762a1bSJed Brown hy = 1.0/real(my + 1) 215c4762a1bSJed Brown hydhx = hy/hx 216c4762a1bSJed Brown hxdhy = hx/hy 217c4762a1bSJed Brown area = 0.5 * hx * hy 218c4762a1bSJed Brown rhx = real(mx) + 1.0 219c4762a1bSJed Brown rhy = real(my) + 1.0 220c4762a1bSJed Brown 221c4762a1bSJed Brown! Get local mesh boundaries 222d8606c27SBarry Smith PetscCall(DMDAGetCorners(dm,xs,ys,PETSC_NULL_INTEGER,xm,ym,PETSC_NULL_INTEGER,ierr)) 223d8606c27SBarry Smith PetscCall(DMDAGetGhostCorners(dm,gxs,gys,PETSC_NULL_INTEGER,gxm,gym,PETSC_NULL_INTEGER,ierr)) 224c4762a1bSJed Brown 225c4762a1bSJed Brown! Scatter ghost points to local vector 226d8606c27SBarry Smith PetscCall(DMGlobalToLocalBegin(dm,X,INSERT_VALUES,localX,ierr)) 227d8606c27SBarry Smith PetscCall(DMGlobalToLocalEnd(dm,X,INSERT_VALUES,localX,ierr)) 228c4762a1bSJed Brown 229c4762a1bSJed Brown! Initialize the vector to zero 230d8606c27SBarry Smith PetscCall(VecSet(localV,zero,ierr)) 231c4762a1bSJed Brown 232*42ce371bSBarry Smith! Get arrays to vector data (See note above about using VecGetArrayF90 in Fortran) 233*42ce371bSBarry Smith PetscCall(VecGetArrayF90(localX,x_v,ierr)) 234*42ce371bSBarry Smith PetscCall(VecGetArrayF90(localV,g_v,ierr)) 235*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Top,top_v,ierr)) 236*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Bottom,bottom_v,ierr)) 237*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Left,left_v,ierr)) 238*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Right,right_v,ierr)) 239c4762a1bSJed Brown 240c4762a1bSJed Brown! Compute function over the locally owned part of the mesh 241c4762a1bSJed Brown do j = ys,ys+ym-1 242c4762a1bSJed Brown do i = xs,xs+xm-1 243c4762a1bSJed Brown row = (j-gys)*gxm + (i-gxs) 244*42ce371bSBarry Smith xc = x_v(1+row) 245c4762a1bSJed Brown xt = xc 246c4762a1bSJed Brown xb = xc 247c4762a1bSJed Brown xr = xc 248c4762a1bSJed Brown xl = xc 249c4762a1bSJed Brown xrb = xc 250c4762a1bSJed Brown xlt = xc 251c4762a1bSJed Brown 252c4762a1bSJed Brown if (i .eq. 0) then !left side 253*42ce371bSBarry Smith xl = left_v(1+j - ys + 1) 254*42ce371bSBarry Smith xlt = left_v(1+j - ys + 2) 255c4762a1bSJed Brown else 256*42ce371bSBarry Smith xl = x_v(1+row - 1) 257c4762a1bSJed Brown endif 258c4762a1bSJed Brown 259c4762a1bSJed Brown if (j .eq. 0) then !bottom side 260*42ce371bSBarry Smith xb = bottom_v(1+i - xs + 1) 261*42ce371bSBarry Smith xrb = bottom_v(1+i - xs + 2) 262c4762a1bSJed Brown else 263*42ce371bSBarry Smith xb = x_v(1+row - gxm) 264c4762a1bSJed Brown endif 265c4762a1bSJed Brown 266c4762a1bSJed Brown if (i + 1 .eq. gxs + gxm) then !right side 267*42ce371bSBarry Smith xr = right_v(1+j - ys + 1) 268*42ce371bSBarry Smith xrb = right_v(1+j - ys) 269c4762a1bSJed Brown else 270*42ce371bSBarry Smith xr = x_v(1+row + 1) 271c4762a1bSJed Brown endif 272c4762a1bSJed Brown 273c4762a1bSJed Brown if (j + 1 .eq. gys + gym) then !top side 274*42ce371bSBarry Smith xt = top_v(1+i - xs + 1) 275*42ce371bSBarry Smith xlt = top_v(1+i - xs) 276c4762a1bSJed Brown else 277*42ce371bSBarry Smith xt = x_v(1+row + gxm) 278c4762a1bSJed Brown endif 279c4762a1bSJed Brown 280c4762a1bSJed Brown if ((i .gt. gxs) .and. (j + 1 .lt. gys + gym)) then 281*42ce371bSBarry Smith xlt = x_v(1+row - 1 + gxm) 282c4762a1bSJed Brown endif 283c4762a1bSJed Brown 284c4762a1bSJed Brown if ((j .gt. gys) .and. (i + 1 .lt. gxs + gxm)) then 285*42ce371bSBarry Smith xrb = x_v(1+row + 1 - gxm) 286c4762a1bSJed Brown endif 287c4762a1bSJed Brown 288c4762a1bSJed Brown d1 = xc-xl 289c4762a1bSJed Brown d2 = xc-xr 290c4762a1bSJed Brown d3 = xc-xt 291c4762a1bSJed Brown d4 = xc-xb 292c4762a1bSJed Brown d5 = xr-xrb 293c4762a1bSJed Brown d6 = xrb-xb 294c4762a1bSJed Brown d7 = xlt-xl 295c4762a1bSJed Brown d8 = xt-xlt 296c4762a1bSJed Brown 297c4762a1bSJed Brown df1dxc = d1 * hydhx 298c4762a1bSJed Brown df2dxc = d1 * hydhx + d4 * hxdhy 299c4762a1bSJed Brown df3dxc = d3 * hxdhy 300c4762a1bSJed Brown df4dxc = d2 * hydhx + d3 * hxdhy 301c4762a1bSJed Brown df5dxc = d2 * hydhx 302c4762a1bSJed Brown df6dxc = d4 * hxdhy 303c4762a1bSJed Brown 304c4762a1bSJed Brown d1 = d1 * rhx 305c4762a1bSJed Brown d2 = d2 * rhx 306c4762a1bSJed Brown d3 = d3 * rhy 307c4762a1bSJed Brown d4 = d4 * rhy 308c4762a1bSJed Brown d5 = d5 * rhy 309c4762a1bSJed Brown d6 = d6 * rhx 310c4762a1bSJed Brown d7 = d7 * rhy 311c4762a1bSJed Brown d8 = d8 * rhx 312c4762a1bSJed Brown 313c4762a1bSJed Brown f1 = sqrt(1.0 + d1*d1 + d7*d7) 314c4762a1bSJed Brown f2 = sqrt(1.0 + d1*d1 + d4*d4) 315c4762a1bSJed Brown f3 = sqrt(1.0 + d3*d3 + d8*d8) 316c4762a1bSJed Brown f4 = sqrt(1.0 + d3*d3 + d2*d2) 317c4762a1bSJed Brown f5 = sqrt(1.0 + d2*d2 + d5*d5) 318c4762a1bSJed Brown f6 = sqrt(1.0 + d4*d4 + d6*d6) 319c4762a1bSJed Brown 320c4762a1bSJed Brown ft = ft + f2 + f4 321c4762a1bSJed Brown 322c4762a1bSJed Brown df1dxc = df1dxc / f1 323c4762a1bSJed Brown df2dxc = df2dxc / f2 324c4762a1bSJed Brown df3dxc = df3dxc / f3 325c4762a1bSJed Brown df4dxc = df4dxc / f4 326c4762a1bSJed Brown df5dxc = df5dxc / f5 327c4762a1bSJed Brown df6dxc = df6dxc / f6 328c4762a1bSJed Brown 329*42ce371bSBarry Smith g_v(1+row) = 0.5 * (df1dxc + df2dxc + df3dxc + df4dxc + df5dxc + df6dxc) 330c4762a1bSJed Brown enddo 331c4762a1bSJed Brown enddo 332c4762a1bSJed Brown 333c4762a1bSJed Brown! Compute triangular areas along the border of the domain. 334c4762a1bSJed Brown if (xs .eq. 0) then ! left side 335c4762a1bSJed Brown do j=ys,ys+ym-1 336*42ce371bSBarry Smith d3 = (left_v(1+j-ys+1) - left_v(1+j-ys+2)) * rhy 337*42ce371bSBarry Smith d2 = (left_v(1+j-ys+1) - x_v(1+(j-gys)*gxm)) * rhx 338c4762a1bSJed Brown ft = ft + sqrt(1.0 + d3*d3 + d2*d2) 339c4762a1bSJed Brown enddo 340c4762a1bSJed Brown endif 341c4762a1bSJed Brown 342c4762a1bSJed Brown if (ys .eq. 0) then !bottom side 343c4762a1bSJed Brown do i=xs,xs+xm-1 344*42ce371bSBarry Smith d2 = (bottom_v(1+i+1-xs)-bottom_v(1+i-xs+2)) * rhx 345*42ce371bSBarry Smith d3 = (bottom_v(1+i-xs+1)-x_v(1+i-gxs))*rhy 346c4762a1bSJed Brown ft = ft + sqrt(1.0 + d3*d3 + d2*d2) 347c4762a1bSJed Brown enddo 348c4762a1bSJed Brown endif 349c4762a1bSJed Brown 350c4762a1bSJed Brown if (xs + xm .eq. mx) then ! right side 351c4762a1bSJed Brown do j=ys,ys+ym-1 352*42ce371bSBarry Smith d1 = (x_v(1+(j+1-gys)*gxm-1)-right_v(1+j-ys+1))*rhx 353*42ce371bSBarry Smith d4 = (right_v(1+j-ys) - right_v(1+j-ys+1))*rhy 354c4762a1bSJed Brown ft = ft + sqrt(1.0 + d1*d1 + d4*d4) 355c4762a1bSJed Brown enddo 356c4762a1bSJed Brown endif 357c4762a1bSJed Brown 358c4762a1bSJed Brown if (ys + ym .eq. my) then 359c4762a1bSJed Brown do i=xs,xs+xm-1 360*42ce371bSBarry Smith d1 = (x_v(1+(gym-1)*gxm+i-gxs) - top_v(1+i-xs+1))*rhy 361*42ce371bSBarry Smith d4 = (top_v(1+i-xs+1) - top_v(1+i-xs))*rhx 362c4762a1bSJed Brown ft = ft + sqrt(1.0 + d1*d1 + d4*d4) 363c4762a1bSJed Brown enddo 364c4762a1bSJed Brown endif 365c4762a1bSJed Brown 366c4762a1bSJed Brown if ((ys .eq. 0) .and. (xs .eq. 0)) then 367*42ce371bSBarry Smith d1 = (left_v(1+0) - left_v(1+1)) * rhy 368*42ce371bSBarry Smith d2 = (bottom_v(1+0)-bottom_v(1+1))*rhx 369c4762a1bSJed Brown ft = ft + sqrt(1.0 + d1*d1 + d2*d2) 370c4762a1bSJed Brown endif 371c4762a1bSJed Brown 372c4762a1bSJed Brown if ((ys + ym .eq. my) .and. (xs + xm .eq. mx)) then 373*42ce371bSBarry Smith d1 = (right_v(1+ym+1) - right_v(1+ym))*rhy 374*42ce371bSBarry Smith d2 = (top_v(1+xm+1) - top_v(1+xm))*rhx 375c4762a1bSJed Brown ft = ft + sqrt(1.0 + d1*d1 + d2*d2) 376c4762a1bSJed Brown endif 377c4762a1bSJed Brown 378c4762a1bSJed Brown ft = ft * area 379d8606c27SBarry Smith PetscCallMPI(MPI_Allreduce(ft,fcn,1,MPIU_SCALAR,MPIU_SUM,PETSC_COMM_WORLD,ierr)) 380c4762a1bSJed Brown 381c4762a1bSJed Brown! Restore vectors 382*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(localX,x_v,ierr)) 383*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(localV,g_v,ierr)) 384*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Left,left_v,ierr)) 385*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Top,top_v,ierr)) 386*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Bottom,bottom_v,ierr)) 387*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Right,right_v,ierr)) 388c4762a1bSJed Brown 389c4762a1bSJed Brown! Scatter values to global vector 390d8606c27SBarry Smith PetscCall(DMLocalToGlobalBegin(dm,localV,INSERT_VALUES,G,ierr)) 391d8606c27SBarry Smith PetscCall(DMLocalToGlobalEnd(dm,localV,INSERT_VALUES,G,ierr)) 392c4762a1bSJed Brown 393d8606c27SBarry Smith PetscCall(PetscLogFlops(70.0d0*xm*ym,ierr)) 394c4762a1bSJed Brown 395c4762a1bSJed Brown return 396c4762a1bSJed Brown end !FormFunctionGradient 397c4762a1bSJed Brown 398c4762a1bSJed Brown! ---------------------------------------------------------------------------- 399c4762a1bSJed Brown! 400c4762a1bSJed Brown! 401c4762a1bSJed Brown! FormHessian - Evaluates Hessian matrix. 402c4762a1bSJed Brown! 403c4762a1bSJed Brown! Input Parameters: 404c4762a1bSJed Brown!. tao - the Tao context 405c4762a1bSJed Brown!. X - input vector 406c4762a1bSJed Brown!. dummy - not used 407c4762a1bSJed Brown! 408c4762a1bSJed Brown! Output Parameters: 409c4762a1bSJed Brown!. Hessian - Hessian matrix 410c4762a1bSJed Brown!. Hpc - optionally different preconditioning matrix 411c4762a1bSJed Brown!. flag - flag indicating matrix structure 412c4762a1bSJed Brown! 413c4762a1bSJed Brown! Notes: 414c4762a1bSJed Brown! Due to mesh point reordering with DMs, we must always work 415c4762a1bSJed Brown! with the local mesh points, and then transform them to the new 416c4762a1bSJed Brown! global numbering with the local-to-global mapping. We cannot work 417c4762a1bSJed Brown! directly with the global numbers for the original uniprocessor mesh! 418c4762a1bSJed Brown! 419c4762a1bSJed Brown! MatSetValuesLocal(), using the local ordering (including 420c4762a1bSJed Brown! ghost points!) 421c4762a1bSJed Brown! - Then set matrix entries using the local ordering 422c4762a1bSJed Brown! by calling MatSetValuesLocal() 423c4762a1bSJed Brown 424c4762a1bSJed Brown subroutine FormHessian(tao, X, Hessian, Hpc, dummy, ierr) 42577d968b7SBarry Smith use plate2fmodule 426c4762a1bSJed Brown implicit none 427c4762a1bSJed Brown 428c4762a1bSJed Brown Tao tao 429c4762a1bSJed Brown Vec X 430c4762a1bSJed Brown Mat Hessian,Hpc 431c4762a1bSJed Brown PetscInt dummy 432c4762a1bSJed Brown PetscErrorCode ierr 433c4762a1bSJed Brown 434c4762a1bSJed Brown PetscInt i,j,k,row 435c4762a1bSJed Brown PetscInt xs,xm,gxs,gxm 436c4762a1bSJed Brown PetscInt ys,ym,gys,gym 437c4762a1bSJed Brown PetscInt col(0:6) 438c4762a1bSJed Brown PetscReal hx,hy,hydhx,hxdhy,rhx,rhy 439c4762a1bSJed Brown PetscReal f1,f2,f3,f4,f5,f6,d1,d2,d3 440c4762a1bSJed Brown PetscReal d4,d5,d6,d7,d8 441c4762a1bSJed Brown PetscReal xc,xl,xr,xt,xb,xlt,xrb 442c4762a1bSJed Brown PetscReal hl,hr,ht,hb,hc,htl,hbr 443c4762a1bSJed Brown 444*42ce371bSBarry Smith PetscReal,pointer :: right_v(:),left_v(:) 445*42ce371bSBarry Smith PetscReal,pointer :: bottom_v(:),top_v(:) 446*42ce371bSBarry Smith PetscReal,pointer :: x_v(:) 447c4762a1bSJed Brown PetscReal v(0:6) 448c4762a1bSJed Brown PetscBool assembled 449c4762a1bSJed Brown PetscInt i1 450c4762a1bSJed Brown 451c4762a1bSJed Brown i1=1 452c4762a1bSJed Brown 453c4762a1bSJed Brown! Set various matrix options 454d8606c27SBarry Smith PetscCall(MatSetOption(Hessian,MAT_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE,ierr)) 455c4762a1bSJed Brown 456c4762a1bSJed Brown! Get local mesh boundaries 457d8606c27SBarry Smith PetscCall(DMDAGetCorners(dm,xs,ys,PETSC_NULL_INTEGER,xm,ym,PETSC_NULL_INTEGER,ierr)) 458d8606c27SBarry Smith PetscCall(DMDAGetGhostCorners(dm,gxs,gys,PETSC_NULL_INTEGER,gxm,gym,PETSC_NULL_INTEGER,ierr)) 459c4762a1bSJed Brown 460c4762a1bSJed Brown! Scatter ghost points to local vectors 461d8606c27SBarry Smith PetscCall(DMGlobalToLocalBegin(dm,X,INSERT_VALUES,localX,ierr)) 462d8606c27SBarry Smith PetscCall(DMGlobalToLocalEnd(dm,X,INSERT_VALUES,localX,ierr)) 463c4762a1bSJed Brown 464c4762a1bSJed Brown! Get pointers to vector data (see note on Fortran arrays above) 465*42ce371bSBarry Smith PetscCall(VecGetArrayF90(localX,x_v,ierr)) 466*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Top,top_v,ierr)) 467*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Bottom,bottom_v,ierr)) 468*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Left,left_v,ierr)) 469*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Right,right_v,ierr)) 470c4762a1bSJed Brown 471c4762a1bSJed Brown! Initialize matrix entries to zero 472d8606c27SBarry Smith PetscCall(MatAssembled(Hessian,assembled,ierr)) 473d8606c27SBarry Smith if (assembled .eqv. PETSC_TRUE) PetscCall(MatZeroEntries(Hessian,ierr)) 474c4762a1bSJed Brown 475c4762a1bSJed Brown rhx = real(mx) + 1.0 476c4762a1bSJed Brown rhy = real(my) + 1.0 477c4762a1bSJed Brown hx = 1.0/rhx 478c4762a1bSJed Brown hy = 1.0/rhy 479c4762a1bSJed Brown hydhx = hy/hx 480c4762a1bSJed Brown hxdhy = hx/hy 481c4762a1bSJed Brown! compute Hessian over the locally owned part of the mesh 482c4762a1bSJed Brown 483c4762a1bSJed Brown do i=xs,xs+xm-1 484c4762a1bSJed Brown do j=ys,ys+ym-1 485c4762a1bSJed Brown row = (j-gys)*gxm + (i-gxs) 486c4762a1bSJed Brown 487*42ce371bSBarry Smith xc = x_v(1+row) 488c4762a1bSJed Brown xt = xc 489c4762a1bSJed Brown xb = xc 490c4762a1bSJed Brown xr = xc 491c4762a1bSJed Brown xl = xc 492c4762a1bSJed Brown xrb = xc 493c4762a1bSJed Brown xlt = xc 494c4762a1bSJed Brown 495c4762a1bSJed Brown if (i .eq. gxs) then ! Left side 496*42ce371bSBarry Smith xl = left_v(1+j - ys + 1) 497*42ce371bSBarry Smith xlt = left_v(1+j - ys + 2) 498c4762a1bSJed Brown else 499*42ce371bSBarry Smith xl = x_v(1+row -1) 500c4762a1bSJed Brown endif 501c4762a1bSJed Brown 502c4762a1bSJed Brown if (j .eq. gys) then ! bottom side 503*42ce371bSBarry Smith xb = bottom_v(1+i - xs + 1) 504*42ce371bSBarry Smith xrb = bottom_v(1+i - xs + 2) 505c4762a1bSJed Brown else 506*42ce371bSBarry Smith xb = x_v(1+row - gxm) 507c4762a1bSJed Brown endif 508c4762a1bSJed Brown 509c4762a1bSJed Brown if (i+1 .eq. gxs + gxm) then !right side 510*42ce371bSBarry Smith xr = right_v(1+j - ys + 1) 511*42ce371bSBarry Smith xrb = right_v(1+j - ys) 512c4762a1bSJed Brown else 513*42ce371bSBarry Smith xr = x_v(1+row + 1) 514c4762a1bSJed Brown endif 515c4762a1bSJed Brown 516c4762a1bSJed Brown if (j+1 .eq. gym+gys) then !top side 517*42ce371bSBarry Smith xt = top_v(1+i - xs + 1) 518*42ce371bSBarry Smith xlt = top_v(1+i - xs) 519c4762a1bSJed Brown else 520*42ce371bSBarry Smith xt = x_v(1+row + gxm) 521c4762a1bSJed Brown endif 522c4762a1bSJed Brown 523c4762a1bSJed Brown if ((i .gt. gxs) .and. (j+1 .lt. gys+gym)) then 524*42ce371bSBarry Smith xlt = x_v(1+row - 1 + gxm) 525c4762a1bSJed Brown endif 526c4762a1bSJed Brown 527c4762a1bSJed Brown if ((i+1 .lt. gxs+gxm) .and. (j .gt. gys)) then 528*42ce371bSBarry Smith xrb = x_v(1+row + 1 - gxm) 529c4762a1bSJed Brown endif 530c4762a1bSJed Brown 531c4762a1bSJed Brown d1 = (xc-xl)*rhx 532c4762a1bSJed Brown d2 = (xc-xr)*rhx 533c4762a1bSJed Brown d3 = (xc-xt)*rhy 534c4762a1bSJed Brown d4 = (xc-xb)*rhy 535c4762a1bSJed Brown d5 = (xrb-xr)*rhy 536c4762a1bSJed Brown d6 = (xrb-xb)*rhx 537c4762a1bSJed Brown d7 = (xlt-xl)*rhy 538c4762a1bSJed Brown d8 = (xlt-xt)*rhx 539c4762a1bSJed Brown 540c4762a1bSJed Brown f1 = sqrt(1.0 + d1*d1 + d7*d7) 541c4762a1bSJed Brown f2 = sqrt(1.0 + d1*d1 + d4*d4) 542c4762a1bSJed Brown f3 = sqrt(1.0 + d3*d3 + d8*d8) 543c4762a1bSJed Brown f4 = sqrt(1.0 + d3*d3 + d2*d2) 544c4762a1bSJed Brown f5 = sqrt(1.0 + d2*d2 + d5*d5) 545c4762a1bSJed Brown f6 = sqrt(1.0 + d4*d4 + d6*d6) 546c4762a1bSJed Brown 547d8606c27SBarry Smith hl = (-hydhx*(1.0+d7*d7)+d1*d7)/(f1*f1*f1)+(-hydhx*(1.0+d4*d4)+d1*d4)/(f2*f2*f2) 548c4762a1bSJed Brown 549d8606c27SBarry Smith hr = (-hydhx*(1.0+d5*d5)+d2*d5)/(f5*f5*f5)+(-hydhx*(1.0+d3*d3)+d2*d3)/(f4*f4*f4) 550c4762a1bSJed Brown 551d8606c27SBarry Smith ht = (-hxdhy*(1.0+d8*d8)+d3*d8)/(f3*f3*f3)+(-hxdhy*(1.0+d2*d2)+d2*d3)/(f4*f4*f4) 552c4762a1bSJed Brown 553d8606c27SBarry Smith hb = (-hxdhy*(1.0+d6*d6)+d4*d6)/(f6*f6*f6)+(-hxdhy*(1.0+d1*d1)+d1*d4)/(f2*f2*f2) 554c4762a1bSJed Brown 555c4762a1bSJed Brown hbr = -d2*d5/(f5*f5*f5) - d4*d6/(f6*f6*f6) 556c4762a1bSJed Brown htl = -d1*d7/(f1*f1*f1) - d3*d8/(f3*f3*f3) 557c4762a1bSJed Brown 558d8606c27SBarry Smith hc = hydhx*(1.0+d7*d7)/(f1*f1*f1) + hxdhy*(1.0+d8*d8)/(f3*f3*f3) + hydhx*(1.0+d5*d5)/(f5*f5*f5) + & 559d8606c27SBarry Smith & hxdhy*(1.0+d6*d6)/(f6*f6*f6) + (hxdhy*(1.0+d1*d1)+hydhx*(1.0+d4*d4)- 2*d1*d4)/(f2*f2*f2) + (hxdhy*(1.0+d2*d2)+ & 560c4762a1bSJed Brown & hydhx*(1.0+d3*d3)-2*d2*d3)/(f4*f4*f4) 561c4762a1bSJed Brown 562c4762a1bSJed Brown hl = hl * 0.5 563c4762a1bSJed Brown hr = hr * 0.5 564c4762a1bSJed Brown ht = ht * 0.5 565c4762a1bSJed Brown hb = hb * 0.5 566c4762a1bSJed Brown hbr = hbr * 0.5 567c4762a1bSJed Brown htl = htl * 0.5 568c4762a1bSJed Brown hc = hc * 0.5 569c4762a1bSJed Brown 570c4762a1bSJed Brown k = 0 571c4762a1bSJed Brown 572c4762a1bSJed Brown if (j .gt. 0) then 573c4762a1bSJed Brown v(k) = hb 574c4762a1bSJed Brown col(k) = row - gxm 575c4762a1bSJed Brown k=k+1 576c4762a1bSJed Brown endif 577c4762a1bSJed Brown 578c4762a1bSJed Brown if ((j .gt. 0) .and. (i .lt. mx-1)) then 579c4762a1bSJed Brown v(k) = hbr 580c4762a1bSJed Brown col(k) = row-gxm+1 581c4762a1bSJed Brown k=k+1 582c4762a1bSJed Brown endif 583c4762a1bSJed Brown 584c4762a1bSJed Brown if (i .gt. 0) then 585c4762a1bSJed Brown v(k) = hl 586c4762a1bSJed Brown col(k) = row - 1 587c4762a1bSJed Brown k = k+1 588c4762a1bSJed Brown endif 589c4762a1bSJed Brown 590c4762a1bSJed Brown v(k) = hc 591c4762a1bSJed Brown col(k) = row 592c4762a1bSJed Brown k=k+1 593c4762a1bSJed Brown 594c4762a1bSJed Brown if (i .lt. mx-1) then 595c4762a1bSJed Brown v(k) = hr 596c4762a1bSJed Brown col(k) = row + 1 597c4762a1bSJed Brown k=k+1 598c4762a1bSJed Brown endif 599c4762a1bSJed Brown 600c4762a1bSJed Brown if ((i .gt. 0) .and. (j .lt. my-1)) then 601c4762a1bSJed Brown v(k) = htl 602c4762a1bSJed Brown col(k) = row + gxm - 1 603c4762a1bSJed Brown k=k+1 604c4762a1bSJed Brown endif 605c4762a1bSJed Brown 606c4762a1bSJed Brown if (j .lt. my-1) then 607c4762a1bSJed Brown v(k) = ht 608c4762a1bSJed Brown col(k) = row + gxm 609c4762a1bSJed Brown k=k+1 610c4762a1bSJed Brown endif 611c4762a1bSJed Brown 612c4762a1bSJed Brown! Set matrix values using local numbering, defined earlier in main routine 613d8606c27SBarry Smith PetscCall(MatSetValuesLocal(Hessian,i1,row,k,col,v,INSERT_VALUES,ierr)) 614c4762a1bSJed Brown 615c4762a1bSJed Brown enddo 616c4762a1bSJed Brown enddo 617c4762a1bSJed Brown 618c4762a1bSJed Brown! restore vectors 619*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(localX,x_v,ierr)) 620*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Left,left_v,ierr)) 621*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Right,right_v,ierr)) 622*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Top,top_v,ierr)) 623*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Bottom,bottom_v,ierr)) 624c4762a1bSJed Brown 625c4762a1bSJed Brown! Assemble the matrix 626d8606c27SBarry Smith PetscCall(MatAssemblyBegin(Hessian,MAT_FINAL_ASSEMBLY,ierr)) 627d8606c27SBarry Smith PetscCall(MatAssemblyEnd(Hessian,MAT_FINAL_ASSEMBLY,ierr)) 628c4762a1bSJed Brown 629d8606c27SBarry Smith PetscCall(PetscLogFlops(199.0d0*xm*ym,ierr)) 630c4762a1bSJed Brown 631c4762a1bSJed Brown return 632c4762a1bSJed Brown end 633c4762a1bSJed Brown 634c4762a1bSJed Brown! Top,Left,Right,Bottom,bheight,mx,my,bmx,bmy,H, defined in plate2f.h 635c4762a1bSJed Brown 636c4762a1bSJed Brown! ---------------------------------------------------------------------------- 637c4762a1bSJed Brown! 638c4762a1bSJed Brown!/* 639c4762a1bSJed Brown! MSA_BoundaryConditions - calculates the boundary conditions for the region 640c4762a1bSJed Brown! 641c4762a1bSJed Brown! 642c4762a1bSJed Brown!*/ 643c4762a1bSJed Brown 644c4762a1bSJed Brown subroutine MSA_BoundaryConditions(ierr) 64577d968b7SBarry Smith use plate2fmodule 646c4762a1bSJed Brown implicit none 647c4762a1bSJed Brown 648c4762a1bSJed Brown PetscErrorCode ierr 649c4762a1bSJed Brown PetscInt i,j,k,limit,maxits 650c4762a1bSJed Brown PetscInt xs, xm, gxs, gxm 651c4762a1bSJed Brown PetscInt ys, ym, gys, gym 652c4762a1bSJed Brown PetscInt bsize, lsize 653c4762a1bSJed Brown PetscInt tsize, rsize 654c4762a1bSJed Brown PetscReal one,two,three,tol 655c4762a1bSJed Brown PetscReal scl,fnorm,det,xt 656c4762a1bSJed Brown PetscReal yt,hx,hy,u1,u2,nf1,nf2 657c4762a1bSJed Brown PetscReal njac11,njac12,njac21,njac22 658c4762a1bSJed Brown PetscReal b, t, l, r 659*42ce371bSBarry Smith PetscReal,pointer :: boundary_v(:) 660*42ce371bSBarry Smith 661c4762a1bSJed Brown logical exitloop 662c4762a1bSJed Brown PetscBool flg 663c4762a1bSJed Brown 664c4762a1bSJed Brown limit=0 665c4762a1bSJed Brown maxits = 5 666c4762a1bSJed Brown tol=1e-10 667c4762a1bSJed Brown b=-0.5 668c4762a1bSJed Brown t= 0.5 669c4762a1bSJed Brown l=-0.5 670c4762a1bSJed Brown r= 0.5 671c4762a1bSJed Brown xt=0 672c4762a1bSJed Brown yt=0 673c4762a1bSJed Brown one=1.0 674c4762a1bSJed Brown two=2.0 675c4762a1bSJed Brown three=3.0 676c4762a1bSJed Brown 677d8606c27SBarry Smith PetscCall(DMDAGetCorners(dm,xs,ys,PETSC_NULL_INTEGER,xm,ym,PETSC_NULL_INTEGER,ierr)) 678d8606c27SBarry Smith PetscCall(DMDAGetGhostCorners(dm,gxs,gys,PETSC_NULL_INTEGER,gxm,gym,PETSC_NULL_INTEGER,ierr)) 679c4762a1bSJed Brown 680c4762a1bSJed Brown bsize = xm + 2 681c4762a1bSJed Brown lsize = ym + 2 682c4762a1bSJed Brown rsize = ym + 2 683c4762a1bSJed Brown tsize = xm + 2 684c4762a1bSJed Brown 685d8606c27SBarry Smith PetscCall(VecCreateMPI(PETSC_COMM_WORLD,bsize,PETSC_DECIDE,Bottom,ierr)) 686d8606c27SBarry Smith PetscCall(VecCreateMPI(PETSC_COMM_WORLD,tsize,PETSC_DECIDE,Top,ierr)) 687d8606c27SBarry Smith PetscCall(VecCreateMPI(PETSC_COMM_WORLD,lsize,PETSC_DECIDE,Left,ierr)) 688d8606c27SBarry Smith PetscCall(VecCreateMPI(PETSC_COMM_WORLD,rsize,PETSC_DECIDE,Right,ierr)) 689c4762a1bSJed Brown 690c4762a1bSJed Brown hx= (r-l)/(mx+1) 691c4762a1bSJed Brown hy= (t-b)/(my+1) 692c4762a1bSJed Brown 693c4762a1bSJed Brown do j=0,3 694c4762a1bSJed Brown 695c4762a1bSJed Brown if (j.eq.0) then 696c4762a1bSJed Brown yt=b 697c4762a1bSJed Brown xt=l+hx*xs 698c4762a1bSJed Brown limit=bsize 699*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Bottom,boundary_v,ierr)) 700c4762a1bSJed Brown 701c4762a1bSJed Brown elseif (j.eq.1) then 702c4762a1bSJed Brown yt=t 703c4762a1bSJed Brown xt=l+hx*xs 704c4762a1bSJed Brown limit=tsize 705*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Top,boundary_v,ierr)) 706c4762a1bSJed Brown 707c4762a1bSJed Brown elseif (j.eq.2) then 708c4762a1bSJed Brown yt=b+hy*ys 709c4762a1bSJed Brown xt=l 710c4762a1bSJed Brown limit=lsize 711*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Left,boundary_v,ierr)) 712c4762a1bSJed Brown 713c4762a1bSJed Brown elseif (j.eq.3) then 714c4762a1bSJed Brown yt=b+hy*ys 715c4762a1bSJed Brown xt=r 716c4762a1bSJed Brown limit=rsize 717*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Right,boundary_v,ierr)) 718c4762a1bSJed Brown endif 719c4762a1bSJed Brown 720c4762a1bSJed Brown do i=0,limit-1 721c4762a1bSJed Brown 722c4762a1bSJed Brown u1=xt 723c4762a1bSJed Brown u2=-yt 724c4762a1bSJed Brown k = 0 725c4762a1bSJed Brown exitloop = .false. 726c4762a1bSJed Brown do while (k .lt. maxits .and. (.not. exitloop)) 727c4762a1bSJed Brown 728c4762a1bSJed Brown nf1=u1 + u1*u2*u2 - u1*u1*u1/three-xt 729c4762a1bSJed Brown nf2=-u2 - u1*u1*u2 + u2*u2*u2/three-yt 730c4762a1bSJed Brown fnorm=sqrt(nf1*nf1+nf2*nf2) 731c4762a1bSJed Brown if (fnorm .gt. tol) then 732c4762a1bSJed Brown njac11=one+u2*u2-u1*u1 733c4762a1bSJed Brown njac12=two*u1*u2 734c4762a1bSJed Brown njac21=-two*u1*u2 735c4762a1bSJed Brown njac22=-one - u1*u1 + u2*u2 736c4762a1bSJed Brown det = njac11*njac22-njac21*njac12 737c4762a1bSJed Brown u1 = u1-(njac22*nf1-njac12*nf2)/det 738c4762a1bSJed Brown u2 = u2-(njac11*nf2-njac21*nf1)/det 739c4762a1bSJed Brown else 740c4762a1bSJed Brown exitloop = .true. 741c4762a1bSJed Brown endif 742c4762a1bSJed Brown k=k+1 743c4762a1bSJed Brown enddo 744c4762a1bSJed Brown 745*42ce371bSBarry Smith boundary_v(1+i) = u1*u1-u2*u2 746c4762a1bSJed Brown if ((j .eq. 0) .or. (j .eq. 1)) then 747c4762a1bSJed Brown xt = xt + hx 748c4762a1bSJed Brown else 749c4762a1bSJed Brown yt = yt + hy 750c4762a1bSJed Brown endif 751c4762a1bSJed Brown 752c4762a1bSJed Brown enddo 753c4762a1bSJed Brown 754c4762a1bSJed Brown if (j.eq.0) then 755*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Bottom,boundary_v,ierr)) 756c4762a1bSJed Brown elseif (j.eq.1) then 757*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Top,boundary_v,ierr)) 758c4762a1bSJed Brown elseif (j.eq.2) then 759*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Left,boundary_v,ierr)) 760c4762a1bSJed Brown elseif (j.eq.3) then 761*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Right,boundary_v,ierr)) 762c4762a1bSJed Brown endif 763c4762a1bSJed Brown 764c4762a1bSJed Brown enddo 765c4762a1bSJed Brown 766c4762a1bSJed Brown! Scale the boundary if desired 767d8606c27SBarry Smith PetscCall(PetscOptionsGetReal(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-bottom',scl,flg,ierr)) 768c4762a1bSJed Brown if (flg .eqv. PETSC_TRUE) then 769d8606c27SBarry Smith PetscCall(VecScale(Bottom,scl,ierr)) 770c4762a1bSJed Brown endif 771c4762a1bSJed Brown 772d8606c27SBarry Smith PetscCall(PetscOptionsGetReal(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-top',scl,flg,ierr)) 773c4762a1bSJed Brown if (flg .eqv. PETSC_TRUE) then 774d8606c27SBarry Smith PetscCall(VecScale(Top,scl,ierr)) 775c4762a1bSJed Brown endif 776c4762a1bSJed Brown 777d8606c27SBarry Smith PetscCall(PetscOptionsGetReal(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-right',scl,flg,ierr)) 778c4762a1bSJed Brown if (flg .eqv. PETSC_TRUE) then 779d8606c27SBarry Smith PetscCall(VecScale(Right,scl,ierr)) 780c4762a1bSJed Brown endif 781c4762a1bSJed Brown 782d8606c27SBarry Smith PetscCall(PetscOptionsGetReal(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-left',scl,flg,ierr)) 783c4762a1bSJed Brown if (flg .eqv. PETSC_TRUE) then 784d8606c27SBarry Smith PetscCall(VecScale(Left,scl,ierr)) 785c4762a1bSJed Brown endif 786c4762a1bSJed Brown 787c4762a1bSJed Brown return 788c4762a1bSJed Brown end 789c4762a1bSJed Brown 790c4762a1bSJed Brown! ---------------------------------------------------------------------------- 791c4762a1bSJed Brown! 792c4762a1bSJed Brown!/* 793c4762a1bSJed Brown! MSA_Plate - Calculates an obstacle for surface to stretch over 794c4762a1bSJed Brown! 795c4762a1bSJed Brown! Output Parameter: 796c4762a1bSJed Brown!. xl - lower bound vector 797c4762a1bSJed Brown!. xu - upper bound vector 798c4762a1bSJed Brown! 799c4762a1bSJed Brown!*/ 800c4762a1bSJed Brown 801c4762a1bSJed Brown subroutine MSA_Plate(tao,xl,xu,dummy,ierr) 80277d968b7SBarry Smith use plate2fmodule 803c4762a1bSJed Brown implicit none 804c4762a1bSJed Brown 805c4762a1bSJed Brown Tao tao 806c4762a1bSJed Brown Vec xl,xu 807c4762a1bSJed Brown PetscErrorCode ierr 808c4762a1bSJed Brown PetscInt i,j,row 809c4762a1bSJed Brown PetscInt xs, xm, ys, ym 810c4762a1bSJed Brown PetscReal lb,ub 811c4762a1bSJed Brown PetscInt dummy 812*42ce371bSBarry Smith PetscReal, pointer :: xl_v(:) 813c4762a1bSJed Brown 814c4762a1bSJed Brown lb = PETSC_NINFINITY 815c4762a1bSJed Brown ub = PETSC_INFINITY 816c4762a1bSJed Brown 817c4762a1bSJed Brown if (bmy .lt. 0) bmy = 0 818c4762a1bSJed Brown if (bmy .gt. my) bmy = my 819c4762a1bSJed Brown if (bmx .lt. 0) bmx = 0 820c4762a1bSJed Brown if (bmx .gt. mx) bmx = mx 821c4762a1bSJed Brown 822d8606c27SBarry Smith PetscCall(DMDAGetCorners(dm,xs,ys,PETSC_NULL_INTEGER,xm,ym,PETSC_NULL_INTEGER,ierr)) 823c4762a1bSJed Brown 824d8606c27SBarry Smith PetscCall(VecSet(xl,lb,ierr)) 825d8606c27SBarry Smith PetscCall(VecSet(xu,ub,ierr)) 826c4762a1bSJed Brown 827*42ce371bSBarry Smith PetscCall(VecGetArrayF90(xl,xl_v,ierr)) 828c4762a1bSJed Brown 829c4762a1bSJed Brown do i=xs,xs+xm-1 830c4762a1bSJed Brown 831c4762a1bSJed Brown do j=ys,ys+ym-1 832c4762a1bSJed Brown 833c4762a1bSJed Brown row=(j-ys)*xm + (i-xs) 834c4762a1bSJed Brown 835c4762a1bSJed Brown if (i.ge.((mx-bmx)/2) .and. i.lt.(mx-(mx-bmx)/2) .and. & 836c4762a1bSJed Brown & j.ge.((my-bmy)/2) .and. j.lt.(my-(my-bmy)/2)) then 837*42ce371bSBarry Smith xl_v(1+row) = bheight 838c4762a1bSJed Brown 839c4762a1bSJed Brown endif 840c4762a1bSJed Brown 841c4762a1bSJed Brown enddo 842c4762a1bSJed Brown enddo 843c4762a1bSJed Brown 844*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(xl,xl_v,ierr)) 845c4762a1bSJed Brown 846c4762a1bSJed Brown return 847c4762a1bSJed Brown end 848c4762a1bSJed Brown 849c4762a1bSJed Brown! ---------------------------------------------------------------------------- 850c4762a1bSJed Brown! 851c4762a1bSJed Brown!/* 852c4762a1bSJed Brown! MSA_InitialPoint - Calculates an obstacle for surface to stretch over 853c4762a1bSJed Brown! 854c4762a1bSJed Brown! Output Parameter: 855c4762a1bSJed Brown!. X - vector for initial guess 856c4762a1bSJed Brown! 857c4762a1bSJed Brown!*/ 858c4762a1bSJed Brown 859c4762a1bSJed Brown subroutine MSA_InitialPoint(X, ierr) 86077d968b7SBarry Smith use plate2fmodule 861c4762a1bSJed Brown implicit none 862c4762a1bSJed Brown 863c4762a1bSJed Brown Vec X 864c4762a1bSJed Brown PetscErrorCode ierr 865c4762a1bSJed Brown PetscInt start,i,j 866c4762a1bSJed Brown PetscInt row 867c4762a1bSJed Brown PetscInt xs,xm,gxs,gxm 868c4762a1bSJed Brown PetscInt ys,ym,gys,gym 869c4762a1bSJed Brown PetscReal zero, np5 870c4762a1bSJed Brown 871*42ce371bSBarry Smith PetscReal,pointer :: left_v(:),right_v(:) 872*42ce371bSBarry Smith PetscReal,pointer :: bottom_v(:),top_v(:) 873*42ce371bSBarry Smith PetscReal,pointer :: x_v(:) 874c4762a1bSJed Brown PetscBool flg 875c4762a1bSJed Brown PetscRandom rctx 876c4762a1bSJed Brown 877c4762a1bSJed Brown zero = 0.0 878c4762a1bSJed Brown np5 = -0.5 879c4762a1bSJed Brown 880d8606c27SBarry Smith PetscCall(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-start', start,flg,ierr)) 881c4762a1bSJed Brown 882c4762a1bSJed Brown if ((flg .eqv. PETSC_TRUE) .and. (start .eq. 0)) then ! the zero vector is reasonable 883d8606c27SBarry Smith PetscCall(VecSet(X,zero,ierr)) 884c4762a1bSJed Brown 885c4762a1bSJed Brown elseif ((flg .eqv. PETSC_TRUE) .and. (start .gt. 0)) then ! random start -0.5 < xi < 0.5 886d8606c27SBarry Smith PetscCall(PetscRandomCreate(PETSC_COMM_WORLD,rctx,ierr)) 887c4762a1bSJed Brown do i=0,start-1 888d8606c27SBarry Smith PetscCall(VecSetRandom(X,rctx,ierr)) 889c4762a1bSJed Brown enddo 890c4762a1bSJed Brown 891d8606c27SBarry Smith PetscCall(PetscRandomDestroy(rctx,ierr)) 892d8606c27SBarry Smith PetscCall(VecShift(X,np5,ierr)) 893c4762a1bSJed Brown 894c4762a1bSJed Brown else ! average of boundary conditions 895c4762a1bSJed Brown 896c4762a1bSJed Brown! Get Local mesh boundaries 897d8606c27SBarry Smith PetscCall(DMDAGetCorners(dm,xs,ys,PETSC_NULL_INTEGER,xm,ym,PETSC_NULL_INTEGER,ierr)) 898d8606c27SBarry Smith PetscCall(DMDAGetGhostCorners(dm,gxs,gys,PETSC_NULL_INTEGER,gxm,gym,PETSC_NULL_INTEGER,ierr)) 899c4762a1bSJed Brown 900c4762a1bSJed Brown! Get pointers to vector data 901*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Top,top_v,ierr)) 902*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Bottom,bottom_v,ierr)) 903*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Left,left_v,ierr)) 904*42ce371bSBarry Smith PetscCall(VecGetArrayF90(Right,right_v,ierr)) 905c4762a1bSJed Brown 906*42ce371bSBarry Smith PetscCall(VecGetArrayF90(localX,x_v,ierr)) 907c4762a1bSJed Brown 908c4762a1bSJed Brown! Perform local computations 909c4762a1bSJed Brown do j=ys,ys+ym-1 910c4762a1bSJed Brown do i=xs,xs+xm-1 911c4762a1bSJed Brown row = (j-gys)*gxm + (i-gxs) 912*42ce371bSBarry Smith x_v(1+row) = ((j+1)*bottom_v(1+i-xs+1)/my + (my-j+1)*top_v(1+i-xs+1)/(my+2) + & 913*42ce371bSBarry Smith & (i+1)*left_v(1+j-ys+1)/mx + (mx-i+1)*right_v(1+j-ys+1)/(mx+2))*0.5 914c4762a1bSJed Brown enddo 915c4762a1bSJed Brown enddo 916c4762a1bSJed Brown 917c4762a1bSJed Brown! Restore vectors 918*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(localX,x_v,ierr)) 919c4762a1bSJed Brown 920*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Left,left_v,ierr)) 921*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Top,top_v,ierr)) 922*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Bottom,bottom_v,ierr)) 923*42ce371bSBarry Smith PetscCall(VecRestoreArrayF90(Right,right_v,ierr)) 924c4762a1bSJed Brown 925d8606c27SBarry Smith PetscCall(DMLocalToGlobalBegin(dm,localX,INSERT_VALUES,X,ierr)) 926d8606c27SBarry Smith PetscCall(DMLocalToGlobalEnd(dm,localX,INSERT_VALUES,X,ierr)) 927c4762a1bSJed Brown 928c4762a1bSJed Brown endif 929c4762a1bSJed Brown 930c4762a1bSJed Brown return 931c4762a1bSJed Brown end 932c4762a1bSJed Brown 933c4762a1bSJed Brown! 934c4762a1bSJed Brown!/*TEST 935c4762a1bSJed Brown! 936c4762a1bSJed Brown! build: 937c4762a1bSJed Brown! requires: !complex 938c4762a1bSJed Brown! 939c4762a1bSJed Brown! test: 940c4762a1bSJed Brown! args: -tao_smonitor -mx 8 -my 6 -bmx 3 -bmy 3 -bheight 0.2 -tao_type bqnls -tao_gatol 1.e-4 941c4762a1bSJed Brown! filter: sort -b 942c4762a1bSJed Brown! filter_output: sort -b 943c4762a1bSJed Brown! requires: !single 944c4762a1bSJed Brown! 945c4762a1bSJed Brown! test: 946c4762a1bSJed Brown! suffix: 2 947c4762a1bSJed Brown! nsize: 2 948c4762a1bSJed Brown! args: -tao_smonitor -mx 8 -my 6 -bmx 3 -bmy 3 -bheight 0.2 -tao_type bqnls -tao_gatol 1.e-4 949c4762a1bSJed Brown! filter: sort -b 950c4762a1bSJed Brown! filter_output: sort -b 951c4762a1bSJed Brown! requires: !single 952c4762a1bSJed Brown! 953c4762a1bSJed Brown!TEST*/ 954