Subroutine initialseed

458 : 
459 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
460 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
461 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
462 : 
463 :       subroutine initialseed ()
464 :       use vom_sce_mod
465 :       implicit none
466 : 
467 :       INTEGER            :: ii
468 :       INTEGER            :: jj, kk
469 :       INTEGER            :: worstcount  ! worstcount for counting number of negative objective functions
470 :       CHARACTER(len=135) :: msg
471 : 
472 :       do ii = 1,sopt
473 : 
474 :         if (ii .eq. 1) then
475 : 
476 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
477 : ! PRINT DIMENSION INFORMATION
478 : 
479 :             write(kfile_progress,*) '  Number of model parameters:         ',vom_npar
480 :             write(kfile_progress,*) '  Number of optimisable parameters:   ',nopt
481 :             write(kfile_progress,*) '  Maximum number of complexes:        ',i_ncomp_
482 :             write(kfile_progress,*) '  Minimum number of runs per complex: ',mopt
483 : 
484 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
485 : ! CALCULATING OF USING INITAL GUESS IN SHUFFLE.PAR
486 : 
487 :             nsincebest = 0
488 :             evolution = 'seed'
489 :             ofvec(:) = -9999.9d0
490 :             shufflevar(:,1) = parval(:)
491 :             nrun = 0
492 :             worstcount = 0
493 : 
494 :           call runmodel(shufflevar(:,1), ofvec(1))
495 : 
496 :             if (ofvec(1) .le. 0.d0) worstcount = worstcount + 1
497 :             bestobj = ofvec(1)
498 :             bestincomp = bestobj
499 :             call write_lastbest(shufflevar(:,1), vom_npar, bestobj, 0)
500 :             write(msg,'("Systematic seed of",i4," parameters for ",i4," complexes. Initial OF= ",e13.6)') nopt, i_ncomp_, ofvec(1)
501 :             write(*,*) TRIM(msg)
502 : 
503 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
504 : ! GENERATE A SYSTEMATIC ARRAY OF INITIAL PARAMETER VALUES FOLLOWING
505 : ! Muttil & Liong (2004, Journal of Hydraulic Engineering-Asce 130(12):1202-1205
506 : ! (INSERTED BY STAN)
507 : !
508 : ! NONAXIAL POINTS:
509 : 
510 :             posarray(1,1) = 1
511 :             posarray(2,1) = 2
512 :             do jj = 1, nopt
513 :               kk = optid(jj)
514 : !             * each position j contains the intial perturbation of an optimised parameter
515 :               initpop(jj,1) = 0.125d0 * parmax(kk) + 0.875d0 * parmin(kk)
516 :               initpop(jj,2) = 0.125d0 * parmin(kk) + 0.875d0 * parmax(kk)
517 :               initpop(jj,3) = 0.5d0 * (parmin(kk) + parmax(kk))
518 :               initpop(jj,4) = 0.25d0 * parmax(kk) + 0.75d0 * parmin(kk)
519 :               initpop(jj,5) = 0.25d0 * parmin(kk) + 0.75d0 * parmax(kk)
520 :               posarray(2**(jj-1)+1:2**jj, 1:jj-1) = posarray(1:2**(jj-1), 1:jj-1)
521 :               posarray(1:2**(jj-1), jj) = 1
522 :               posarray(2**(jj-1)+1:2**jj, jj) = 2
523 :             enddo
524 :         endif
525 : 
526 :         if (ii .gt. 1) then
527 :             shufflevar(:,ii) = parval(:)  ! TO SET NON-OPTIMISING PARAMETERS
528 :         endif
529 : 
530 :         if (ii .gt. 1 .and. ii .le. 4) then
531 :             do jj = 1, nopt
532 :               kk = optid(jj)
533 :               shufflevar(kk,ii) = initpop(jj,ii+1)
534 :             enddo
535 : 
536 :           call runmodel(shufflevar(:,ii), ofvec(ii))
537 : 
538 :             if (ofvec(ii) .le. 0) worstcount = worstcount + 1
539 :         endif
540 : 
541 :         if (ii .gt. 4 .and. ii .le. SIZE(posarray(:,:),1)) then
542 :             do jj = 1, nopt
543 :               kk = optid(jj)
544 :               shufflevar(kk,ii) = initpop(jj, posarray(ii-4, jj))
545 :             enddo
546 : 
547 :           call runmodel(shufflevar(:,ii), ofvec(ii))
548 : 
549 :             if (ofvec(ii) .le. 0) worstcount = worstcount + 1
550 :         endif
551 : 
552 : !       * IF MORE POINTS ARE NEEDED, GENERATE RANDOM POINTS
553 : 
554 :         if (ii .gt. SIZE(posarray(:,:),1)) then
555 :           evolution = 'mutation'
556 : 
557 : !         * first loop must generate feasible values to start with
558 :           do while (ofvec(ii) .le. 0.d0)
559 : 
560 :               call random_number(ranarr(:))  ! RANDOM ARRAY OF SIZE 1:nopt
561 :               do jj = 1, nopt
562 :                 kk = optid(jj)
563 : 
564 : !               * STAN'S MODIFICATION TO GET COMPLETELY RANDOM SEED:
565 : 
566 :                 shufflevar(kk,ii) = parmin(kk) + i_focus               &
567 :      &                            * (parmax(kk) - parmin(kk)) * ranarr(jj)
568 :               enddo
569 :               shufflevar(optid(:),ii) = MERGE(shufflevar(optid(:),ii), parmin(optid(:)), &
570 :      &                                  shufflevar(optid(:),ii) .gt. parmin(optid(:)))
571 :               shufflevar(optid(:),ii) = MERGE(shufflevar(optid(:),ii), parmax(optid(:)), &
572 :      &                                  shufflevar(optid(:),ii) .lt. parmax(optid(:)))
573 : 
574 :             call runmodel(shufflevar(:,ii), ofvec(ii))
575 : 
576 :               if (ofvec(ii) .le. 0) worstcount = worstcount + 1
577 : 
578 :           enddo
579 : 
580 :         endif
581 : 
582 :           if (ofvec(ii) .gt. bestobj) then
583 :             bestobj = ofvec(ii)
584 :             call write_lastbest(shufflevar(:,ii), vom_npar, bestobj, 0)
585 :           endif
586 : 
587 :         if (success .eq. 2) exit
588 :       enddo
589 : 
590 :         nloop = -1                      ! FIRST LOOP IS LOOP ZERO
591 :         call writeloop()
592 :         !close(kfile_sceout)
593 :         close(kfile_bestpars)
594 :         if (kfile_progress .ne. 6) close(kfile_progress)
595 : 
596 :       return
597 :       end subroutine initialseed