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