| 1 | include 'pgapackf.h' |
|---|
| 2 | |
|---|
| 3 | double precision evaluate |
|---|
| 4 | integer myMutation |
|---|
| 5 | external evaluate, myMutation |
|---|
| 6 | |
|---|
| 7 | integer ctx |
|---|
| 8 | integer i, ierror |
|---|
| 9 | integer lower(10), upper(10) |
|---|
| 10 | |
|---|
| 11 | do i=1, 10 |
|---|
| 12 | lower(i) = 1 |
|---|
| 13 | upper(i) = 10 |
|---|
| 14 | enddo |
|---|
| 15 | |
|---|
| 16 | call MPI_Init(ierror) |
|---|
| 17 | |
|---|
| 18 | ctx = PGACreate (PGA_DATATYPE_INTEGER, 10, PGA_MAXIMIZE) |
|---|
| 19 | call PGASetUserFunction (ctx, PGA_USERFUNCTION_MUTATION, |
|---|
| 20 | & myMutation) |
|---|
| 21 | call PGASetIntegerInitRange(ctx, lower, upper) |
|---|
| 22 | call PGASetUp (ctx) |
|---|
| 23 | call PGARun (ctx, evaluate) |
|---|
| 24 | call PGADestroy (ctx) |
|---|
| 25 | |
|---|
| 26 | call MPI_Finalize(ierror) |
|---|
| 27 | |
|---|
| 28 | stop |
|---|
| 29 | end |
|---|
| 30 | |
|---|
| 31 | |
|---|
| 32 | integer function myMutation(ctx, p, pop, pm) |
|---|
| 33 | include 'pgapackf.h' |
|---|
| 34 | integer ctx |
|---|
| 35 | integer p, pop |
|---|
| 36 | double precision pm |
|---|
| 37 | integer stringlen, i, k, count |
|---|
| 38 | |
|---|
| 39 | count = 0 |
|---|
| 40 | stringlen = PGAGetStringLength(ctx) |
|---|
| 41 | do i=1, stringlen |
|---|
| 42 | if (PGARandomFlip(ctx, pm) .eq. PGA_TRUE) then |
|---|
| 43 | k = PGARandomInterval(ctx, 1, stringlen) |
|---|
| 44 | call PGASetIntegerAllele(ctx, p, pop, i, k) |
|---|
| 45 | count = count + 1 |
|---|
| 46 | endif |
|---|
| 47 | enddo |
|---|
| 48 | myMutation = count |
|---|
| 49 | return |
|---|
| 50 | end |
|---|
| 51 | |
|---|
| 52 | |
|---|
| 53 | double precision function evaluate(ctx, p, pop) |
|---|
| 54 | include 'pgapackf.h' |
|---|
| 55 | integer ctx |
|---|
| 56 | integer p, pop |
|---|
| 57 | integer stringlen, i, sum |
|---|
| 58 | |
|---|
| 59 | sum = 0 |
|---|
| 60 | stringlen = PGAGetStringLength(ctx) |
|---|
| 61 | do i=1, stringlen |
|---|
| 62 | sum = sum + PGAGetIntegerAllele(ctx, p, pop, i) |
|---|
| 63 | enddo |
|---|
| 64 | evaluate = sum |
|---|
| 65 | return |
|---|
| 66 | end |
|---|
