V3FIT
ga_possibl.f
1  SUBROUTINE ga_possibl(array, iarray, myid)
2 c#######################################################################
3 c
4 c This SUBROUTINE determines whether or not ALL parameters are within
5 c the specified range of possibility. If not, the PARAMETER is
6 c randomly reassigned within the range. This SUBROUTINE is ONLY
7 c necessary when the number of possibilities per PARAMETER is not
8 c optimized to be 2**n, i.e. IF nposSUM < ig2sum.
9 c
10  USE ga_mod
11  USE mpi_params, ONLY: master
12  IMPLICIT NONE
13 
14  REAL(rprec), DIMENSION(nparmax,indmax) :: array
15  INTEGER, DIMENSION(nchrmax,indmax) :: iarray
16  INTEGER :: i, j, n2ig2j, irand, myid
17  REAL(rprec) :: rand
18 
19  SAVE
20 c
21  DO 10 i=1,npopsiz
22  CALL ga_decode(i,array,iarray)
23  DO 20 j=1,nparam
24  n2ig2j=ig2(j)
25  IF(nposibl(j).ne.n2ig2j .and. array(j,i).gt.par_max(j)) THEN
26  CALL ran3(1,rand)
27  irand=int((2**nposibl(j))*rand)
28  array(j,i)=g0(j)+irand*g1(j)
29  CALL ga_code(i,j,array,iarray)
30  IF (nowrite.eq.0 .and. myid.eq.master) THEN
31  WRITE(6,1000) i,j
32  WRITE(iunit_ga_out,1000) i,j
33  END IF
34  END IF
35  20 CONTINUE
36  10 CONTINUE
37 
38  1000 FORMAT('*** Parameter adjustment to individual ',i4,
39  1 ', PARAMETER ',i3,' ***')
40 
41  END SUBROUTINE ga_possibl