Subroutine sortcomp
1119 :
1120 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1121 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1122 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1123 :
1124 : subroutine sortcomp (invar, dim_invar, objfun, dim_objfun)
1125 : implicit none
1126 :
1127 : ! * Declarations
1128 : INTEGER, DIMENSION(2), INTENT(in) :: dim_invar
1129 : REAL*8, DIMENSION(dim_invar(1),dim_invar(2)), INTENT(inout) :: invar
1130 : INTEGER, INTENT(in) :: dim_objfun
1131 : REAL*8, DIMENSION(dim_objfun), INTENT(inout) :: objfun
1132 :
1133 : ! * Definitions
1134 : INTEGER :: ii, jj(1)
1135 :
1136 : REAL*8, DIMENSION(:), ALLOCATABLE :: objfun2
1137 : REAL*8, DIMENSION(:,:), ALLOCATABLE :: invar2
1138 : INTEGER, DIMENSION(:), ALLOCATABLE :: newobjfun
1139 :
1140 : allocate(objfun2(dim_objfun))
1141 : allocate(invar2(dim_invar(1),dim_invar(2)))
1142 : allocate(newobjfun(dim_objfun))
1143 :
1144 : ! * EXTERNAL compar
1145 :
1146 : objfun2(:) = objfun(:)
1147 : newobjfun(:) = -99 ! NEEDED TO SEPARATE EQUAL O.F. VALUES
1148 : invar2(:,:) = invar(:,:)
1149 : ! call qsort(objfun(:), dim, 8, compar) ! USE compar(b,c)=(c-b)/dabs(c-b)
1150 : call qsort(objfun(:), dim_objfun)
1151 : do ii = 1, dim_objfun
1152 : jj = MINLOC(REAL(dabs(objfun2(:) - objfun(ii))), newobjfun(:) .lt. 0)
1153 : newobjfun(jj(1)) = ii
1154 : invar(:,ii) = invar2(:,jj(1))
1155 : enddo
1156 :
1157 : deallocate(objfun2)
1158 : deallocate(invar2)
1159 : deallocate(newobjfun)
1160 :
1161 : return
1162 : end subroutine sortcomp