Subroutine qsort
1256 :
1257 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1258 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1259 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1260 : ! * SORTS THE VECTOR OBJFUN IN DESCENDING ORDER AND RETURNS IT
1261 :
1262 : subroutine qsort (objfun, dim_objfun)
1263 : implicit none
1264 :
1265 : ! * Declarations
1266 : INTEGER, INTENT(in) :: dim_objfun
1267 : REAL*8, DIMENSION(dim_objfun), INTENT(inout) :: objfun
1268 :
1269 : ! * Definitions
1270 : INTEGER :: ii, jj, kk
1271 :
1272 : do ii = 2, dim_objfun
1273 : if (objfun(ii) .gt. objfun(ii-1)) then
1274 : kk = ii - 2
1275 : do jj = ii - 2, 1, -1
1276 : kk = jj
1277 : if (objfun(ii) .lt. objfun(jj)) exit
1278 : if (jj .eq. 1) kk = 0 ! If objfun(ii)>objfun(1), then cycle objfun(ii) to the top
1279 : enddo
1280 : objfun(kk+1:ii) = CSHIFT(objfun(kk+1:ii), -1)
1281 : endif
1282 : enddo
1283 :
1284 : ! For debugging:
1285 : !!$ do ii = 1, dim_objfun
1286 : !!$ print *, objfun(ii)
1287 : !!$ enddo
1288 :
1289 : return
1290 : end subroutine qsort