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