fcn Subroutine

  1. class_cylinder_procedures.f90
  2. class_cylinder_procedures
  3. fcn

subroutine fcn(iflag, nverts, nunknowns, unknowns, err, fjac, ldfjac)

Uses

  • proc~~fcn~~UsesGraph proc~fcn fcn module~class_vector class_vector proc~fcn->module~class_vector module~class_psblas class_psblas proc~fcn->module~class_psblas module~class_vector->module~class_psblas module~class_stopwatch class_stopwatch module~class_psblas->module~class_stopwatch module~tools_psblas tools_psblas module~class_psblas->module~tools_psblas module~class_stopwatch->module~tools_psblas psb_base_mod psb_base_mod module~class_stopwatch->psb_base_mod psb_prec_mod psb_prec_mod module~tools_psblas->psb_prec_mod module~tools_psblas->psb_base_mod psb_krylov_mod psb_krylov_mod module~tools_psblas->psb_krylov_mod

This is the function of merit to be optimized

Arguments

Type IntentOptional AttributesName
integer, intent(in) :: iflag
integer, intent(in) :: nverts
integer, intent(in) :: nunknowns
real(kind=psb_dpk_), intent(in) :: unknowns(6)
real(kind=psb_dpk_), intent(out) :: err(nverts)
real(kind=psb_dpk_), intent(in) :: fjac(1,1)
integer, intent(in) :: ldfjac

Calls

proc~~fcn~~CallsGraph proc~fcn fcn interface~abort_psblas abort_psblas proc~fcn->interface~abort_psblas interface~vector_ vector_ proc~fcn->interface~vector_ my_vertices my_vertices proc~fcn->my_vertices proc~abort_psblas abort_psblas interface~abort_psblas->proc~abort_psblas proc~vector_ vector_ interface~vector_->proc~vector_ psb_abort psb_abort proc~abort_psblas->psb_abort

Contents

Source Code

fcn

Source Code

    SUBROUTINE FCN(iflag,nverts,nunknowns,unknowns,err,FJAC,LDFJAC)
    !! This is the function of merit to be optimized
        USE class_psblas
        USE class_vector

        IMPLICIT NONE

        INTEGER,INTENT(IN)            :: iflag
        INTEGER,INTENT(IN)            :: nverts             ! number of vertices (M)
        INTEGER,INTENT(IN)            :: nunknowns          ! number of variables (N)
        REAL(psb_dpk_),INTENT(IN)  :: unknowns(6)
        REAL(psb_dpk_),INTENT(OUT) :: err(nverts)
        REAL(psb_dpk_),INTENT(IN)  :: fjac(1,1)     ! ignored
        INTEGER,INTENT(IN)            :: ldfjac        ! ignored

        TYPE(vector)        :: center
        TYPE(vector)        :: axis
        REAL(psb_dpk_)   :: radius

        ! Local variables
        INTEGER                        :: i
        TYPE(vector)                   :: x,xrad,xrel
        REAL(psb_dpk_)              :: ax,ay,az           ! components of the axis vector
        REAL(psb_dpk_)              :: alpha, beta        !angles of cylinder rotation

        INTEGER                        :: idummy             ! this variable exists to make the
        ! compiler happy, but serves no other use

        idummy = SIZE(fjac) ! since we don't control the interface to this subroutines, we must
        idummy = ldfjac     ! include these two unused variables.  These two lines make them
        ! appear used and suppressed "unused variable warnings.

        IF (nunknowns /= SIZE(unknowns) ) THEN
            WRITE(6,*)"Error in argument to FCN"
            CALL abort_psblas
        ENDIF

        IF (iflag == 0) THEN
            WRITE(6,'(a)')"========= Center        X           Y           Z          ALPHA       &
                &BETA        RADIUS"
            WRITE(6,'(a,6(2x,e10.4))')"The unknowns are: ",unknowns
            RETURN
        ENDIF

        center = vector_(unknowns(1),unknowns(2),unknowns(3))
        alpha  = unknowns(4)
        beta   = unknowns(5)
        radius = unknowns(6)

        ax =  SIN(beta)
        ay = -SIN(alpha)*COS(beta)
        az =  COS(alpha)*COS(beta)

        axis = vector_(ax,ay,az)

        !    nverts = size(my_vertices)

        err = 0

        ! calculate cumulative error
        DO i = 1,nverts

            x = my_vertices(i)%position_()

            ! calculate position relative to the cylinder's center
            xrel = x - center

            ! get radial vector
            xrad = xrel - ( xrel .dot. axis) * axis

            ! because our ideal cylinder is infinitely long, the error is only
            ! the vector difference in the radial direction

            err(i) =  ( xrad%mag() - radius)**2

        ENDDO

    END SUBROUTINE FCN