Subroutine cce

869 : 
870 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
871 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
872 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
873 : 
874 :       subroutine cce (objfun, invar)
875 :       use vom_sce_mod
876 : 
877 :       implicit none
878 : 
879 : !     * Declarations
880 :       REAL*8, DIMENSION(mopt),          INTENT(inout) :: objfun
881 :       REAL*8, DIMENSION(vom_npar,mopt), INTENT(inout) :: invar
882 : 
883 : !     * Definitions
884 :       INTEGER       :: l_
885 :       INTEGER       :: ii, nsel, rannum
886 :       INTEGER       :: tmp2(2)
887 :       REAL*8  :: ranscal2                ! Scalar random number
888 :       LOGICAL, DIMENSION(mopt) :: selected
889 :       INTEGER, DIMENSION(qopt) :: parentsid  ! Pointer to optimisable parameters
890 :       REAL*8, DIMENSION(qopt) :: objfunsub  ! Pointer to optimisable parameters
891 :       REAL*8, DIMENSION(vom_npar,qopt) :: invarsub  ! Pointer to optimisable parameters
892 : 
893 : !     * SELECT PARENTS
894 : 
895 :       do l_ = 1, mopt
896 : 
897 :           selected(:) = .false.
898 :           nsel = 0
899 : 
900 :           do while (nsel .ne. qopt)
901 :             call random_number(ranscal2)      ! SCALAR RANDOM NUMBER
902 :             rannum = CEILING((2.d0 * mopt + 1.d0 - sqrt(4.d0 * mopt    &
903 :      &             * (mopt + 1.d0) * (1.d0 - ranscal2) + 1.d0)) * 0.5d0)
904 : 
905 : !           * NOTE: A SIMPLER ALTERNATIVE TO THE ABOVE LINE IS (19.03.2004):
906 : 
907 :             if (rannum .ge. 1 .and. rannum .le. mopt) then
908 :               if (.not. selected(rannum)) then
909 :                 selected(rannum) = .true.
910 :                 nsel = nsel + 1
911 :               endif
912 :             endif
913 :           enddo
914 : 
915 :           nsel = 0
916 :           ii = 0
917 :           do while (nsel .ne. qopt)
918 :             ii = ii + 1
919 :             if (selected(ii)) then
920 :               nsel = nsel + 1
921 :               parentsid(nsel) = ii
922 :             endif
923 :           enddo
924 : 
925 : !         * GENERATE OFFSPRING AND SORT THE RESULTING COMPLEX
926 : 
927 :           objfunsub(:) = objfun(parentsid(:))
928 :           invarsub(:,:) = invar(:, parentsid(:))
929 : 
930 :         call simplex(invarsub(:,:), objfunsub(:))
931 : 
932 :           objfun(parentsid(:)) = objfunsub(:)
933 :           invar(:, parentsid(:)) = invarsub(:,:)
934 : !         * use temporary variable to prevent warning in ifort
935 :           tmp2(:) = SHAPE(invar)
936 :           call sortcomp(invar, tmp2(:), objfun, SIZE(objfun))
937 : 
938 :       enddo
939 : 
940 :       return
941 :       end subroutine cce