Date: 2024-10-28T09:14:30+00:00

Actual source code: test1f.F90
slepc-3.22.1 2024-10-28
Report Typos and Errors

      1: !
      2: !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3: !  SLEPc - Scalable Library for Eigenvalue Problem Computations
      4: !  Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
      5: !
      6: !  This file is part of SLEPc.
      7: !  SLEPc is distributed under a 2-clause BSD license (see LICENSE).
      8: !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      9: !
     10: !  Program usage: mpiexec -n <np> ./test1f [-help]
     11: !
     12: !  Description: Simple example that tests BV interface functions.
     13: !
     14: ! ----------------------------------------------------------------------
     15: !
     16:       program main
     17: #include <slepc/finclude/slepcbv.h>
     18:       use slepcbv
     19:       implicit none

     21: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     22: !     Declarations
     23: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     25: #define KMAX 35

     27:       Vec            t,v
     28:       Mat            Q,M
     29:       BV             X,Y;
     30:       PetscMPIInt    rank
     31:       PetscInt       i,j,n,k,l,izero,ione
     32:       PetscScalar    z(KMAX),val
     33:       PetscScalar, pointer :: qq(:,:)
     34:       PetscScalar    one,mone,two,zero
     35:       PetscReal      nrm
     36:       PetscBool      flg
     37:       PetscErrorCode ierr

     39: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     40: !     Beginning of program
     41: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     43:       n = 10
     44:       k = 5
     45:       l = 3
     46:       one = 1.0
     47:       mone = -1.0
     48:       two = 2.0
     49:       zero = 0.0
     50:       izero = 0
     51:       ione = 1
     52:       PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,ierr))
     53:       if (ierr .ne. 0) then
     54:         print*,'SlepcInitialize failed'
     55:         stop
     56:       endif
     57:       PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
     58:       PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr))
     59:       PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-k',k,flg,ierr))
     60:       PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-l',l,flg,ierr))
     61:       if (k .gt. KMAX) then; SETERRA(PETSC_COMM_SELF,1,'Program currently limited to k=35'); endif
     62:       if (rank .eq. 0) then
     63:         write(*,110) k,n
     64:       endif
     65:  110  format (/'Test BV with',I3,' columns of length',I3,' (Fortran)')

     67: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     68: !     Initialize data
     69: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     71: !     ** Create template vector
     72:       PetscCallA(VecCreate(PETSC_COMM_WORLD,t,ierr))
     73:       PetscCallA(VecSetSizes(t,PETSC_DECIDE,n,ierr))
     74:       PetscCallA(VecSetFromOptions(t,ierr))

     76: !     ** Create BV object X
     77:       PetscCallA(BVCreate(PETSC_COMM_WORLD,X,ierr))
     78:       PetscCallA(BVSetSizesFromVec(X,t,k,ierr))
     79:       PetscCallA(BVSetFromOptions(X,ierr))

     81: !     ** Fill X entries
     82:       do j=0,k-1
     83:         PetscCallA(BVGetColumn(X,j,v,ierr))
     84:         PetscCallA(VecSet(v,zero,ierr))
     85:         do i=0,3
     86:           if (i+j<n) then
     87:             val = 3*i+j-2
     88:             PetscCallA(VecSetValue(v,i+j,val,INSERT_VALUES,ierr))
     89:           end if
     90:         end do
     91:         PetscCallA(VecAssemblyBegin(v,ierr))
     92:         PetscCallA(VecAssemblyEnd(v,ierr))
     93:         PetscCallA(BVRestoreColumn(X,j,v,ierr))
     94:       end do

     96: !     ** Create BV object Y
     97:       PetscCallA(BVCreate(PETSC_COMM_WORLD,Y,ierr))
     98:       PetscCallA(BVSetSizesFromVec(Y,t,l,ierr))
     99:       PetscCallA(BVSetFromOptions(Y,ierr))

    101: !     ** Fill Y entries
    102:       do j=0,l-1
    103:         PetscCallA(BVGetColumn(Y,j,v,ierr))
    104:         val = real(j+1)/4.0
    105:         PetscCallA(VecSet(v,val,ierr))
    106:         PetscCallA(BVRestoreColumn(Y,j,v,ierr))
    107:       end do

    109: !     ** Create Mat
    110:       PetscCallA(MatCreateSeqDense(PETSC_COMM_SELF,k,l,PETSC_NULL_SCALAR_ARRAY,Q,ierr))
    111:       PetscCallA(MatDenseGetArrayF90(Q,qq,ierr))
    112:       do i=1,k
    113:         do j=1,l
    114:           if (i<j) then
    115:             qq(i,j) = 2.0
    116:           else
    117:             qq(i,j) = -0.5
    118:           end if
    119:         end do
    120:       end do
    121:       PetscCallA(MatDenseRestoreArrayF90(Q,qq,ierr))

    123: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    124: !     Test several operations
    125: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    127: !     ** Test BVMult
    128:       PetscCallA(BVMult(Y,two,one,X,Q,ierr))

    130: !     ** Test BVMultVec
    131:       PetscCallA(BVGetColumn(Y,izero,v,ierr))
    132:       z(1) = 2.0
    133:       do i=2,k
    134:         z(i) = -0.5*z(i-1)
    135:       end do
    136:       PetscCallA(BVMultVec(X,mone,one,v,z,ierr))
    137:       PetscCallA(BVRestoreColumn(Y,izero,v,ierr))

    139: !     ** Test BVDot
    140:       PetscCallA(MatCreateSeqDense(PETSC_COMM_SELF,l,k,PETSC_NULL_SCALAR_ARRAY,M,ierr))
    141:       PetscCallA(BVDot(X,Y,M,ierr))

    143: !     ** Test BVDotVec
    144:       PetscCallA(BVGetColumn(Y,izero,v,ierr))
    145:       PetscCallA(BVDotVec(X,v,z,ierr))
    146:       PetscCallA(BVRestoreColumn(Y,izero,v,ierr))

    148: !     ** Test BVMultInPlace and BVScale
    149:       PetscCallA(BVMultInPlace(X,Q,ione,l,ierr))
    150:       PetscCallA(BVScale(X,two,ierr))

    152: !     ** Test BVNorm
    153:       PetscCallA(BVNormColumn(X,izero,NORM_2,nrm,ierr))
    154:       if (rank .eq. 0) then
    155:         write(*,120) nrm
    156:       endif
    157:  120  format ('2-Norm of X[0] = ',f8.4)
    158:       PetscCallA(BVNorm(X,NORM_FROBENIUS,nrm,ierr))
    159:       if (rank .eq. 0) then
    160:         write(*,130) nrm
    161:       endif
    162:  130  format ('Frobenius Norm of X = ',f8.4)

    164: !     *** Clean up
    165:       PetscCallA(BVDestroy(X,ierr))
    166:       PetscCallA(BVDestroy(Y,ierr))
    167:       PetscCallA(VecDestroy(t,ierr))
    168:       PetscCallA(MatDestroy(Q,ierr))
    169:       PetscCallA(MatDestroy(M,ierr))
    170:       PetscCallA(SlepcFinalize(ierr))
    171:       end

    173: !/*TEST
    174: !
    175: !   test:
    176: !      suffix: 1
    177: !      nsize: 1
    178: !      args: -bv_type {{vecs contiguous svec mat}separate output}
    179: !      output_file: output/test1f_1.out
    180: !
    181: !   test:
    182: !      suffix: 2
    183: !      nsize: 2
    184: !      args: -bv_type {{vecs contiguous svec mat}separate output}
    185: !      output_file: output/test1f_1.out
    186: !
    187: !TEST*/