module GENERIC_GA !====================================================================== !The module GENERIC_GA provides data structures for use in designing !composite materials with genetic algorithms. !Data structures are supplied for all entities found in a population of !composite structures. ! !A population is a structure defined in this module. !Variables of type (POPLTN) inherit this structure and can be initialized !and manipulated by module functions and subprograms. Schematically, !the population structure is: ! ! Population ! | ! Subpopulations ! | ! Individuals ! | | ! Laminate Chromosomes Geometry Chromosomes ! | | ! Ply Genes Geometry Genes ! | | ! |orientation |digit ! |material ! ! !The individual attributes for a population in this module are stored !in a structure, inherited by using type (INDIVIDUAL_ATTRIBS). The !module global variable INDIVIDUAL_ATTRIBUTES of type (INDIVIDUAL_ATTRIBS) !is used to define all attributes of an individual. INDIVIDUAL_ATTRIBUTES !serves as a means of communicating user-defined data (e.g., from an !input file) to the module. Schematically, the INDIVIDUAL_ATTRIBUTES !structure is: ! ! Individual Attributes ! | | ! |size_lam |size_geom ! | | ! Laminate Attributes Geometry Attributes ! | | ! |laminate chromo size |geometry chromo size ! |crossover type |upper bounds array ! |mutation type |lower bounds array ! |empty plies | ! | |prob_mutation ! |num materials |prob_crossover ! |material array ! | ! |num orientations ! |orientation array ! | ! |prob_crossover ! |prob_mut_orientation ! |prob_mut_material ! |prob_ply_addition ! |prob_ply_deletion ! |prob_intra_ply_swap ! |prob_permutation ! !Variables used in defining a population: ! ! POPULATION_SIZE specifies the number of subpopulations in a population. ! SUBPOPULATION_SIZE specifies the number of individuals in a subpopulation. ! !Functions contained in this module: ! ! FINDIVIDUAL ! FORIENTATION ! FMATERIAL ! FSTRUCTURE ! FGEOMETRY ! FINDIVIDUAL_COMPARE ! CREATE_CHILD ! !Subroutines contained in this module: ! ! INITIALIZE_POPULATION ! RANDOMIZER ! !=========================================================================== !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! genetic data types !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Create specifications for numbers. ! 2-digit integers integer, parameter :: small = selected_int_kind(2) ! 64-bit IEEE reals integer, parameter :: R8 = selected_real_kind(15,307) ! Population variables: integer :: population_size, subpopulation_size !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Gene data types: type ply_gene integer (KIND=small) ::orientation integer (KIND=small) ::material end type ply_gene type geometry_gene real (KIND=R8) ::digit end type geometry_gene ! Chromosome data types: type laminate_chromosome type (ply_gene), pointer, dimension(:):: ply_array end type laminate_chromosome type geometry_chromosome type (geometry_gene), pointer, dimension(:):: & geometry_gene_array end type geometry_chromosome ! Individual (structure) data type: type individual type (laminate_chromosome),pointer,dimension(:):: & laminate_array type (geometry_chromosome),pointer,dimension(:):: & geometry_array end type individual ! Subpopulation data type: type subpopulation type (individual), pointer, dimension(:):: & individual_array end type subpopulation ! Population data type: type popltn type (subpopulation), pointer, dimension(:):: & subpopulation_array end type popltn !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Data types for individual attributes: ! Types for each laminate's attribute definitions type laminate_attributes integer :: laminate_size integer :: crossover_type integer :: mutation_type logical :: empty_plies integer :: num_materials integer, pointer, dimension(:) :: material_array integer :: num_poss_orientations integer, pointer, dimension(:) :: orientation_array real (KIND = R8) :: prob_crossover, prob_mut_orientation, & prob_mut_material, & prob_ply_addition, prob_ply_deletion, & prob_intra_ply_swap, prob_permutation end type laminate_attributes ! Types for each geometry's attribute definitions: type geometry_attributes integer :: geom_chromo_size real (KIND = R8), pointer, dimension(:) :: lower_bounds_array real (KIND = R8), pointer, dimension(:) :: upper_bounds_array real (KIND = R8) :: prob_mutation, prob_crossover end type geometry_attributes ! Type for individual attributes: type individual_attribs integer :: individual_size_lam integer :: individual_size_geom real (KIND = R8) :: prob_inter_ply_swap type (laminate_attributes), pointer, dimension(:):: & laminate_definition_array type (geometry_attributes),pointer, dimension(:):: & geometry_definition_array end type individual_attribs !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Global variables: ! The variable INDIVIDUAL_ATTRIBUTES is used to specify an ! individual. ! It must be initialized by the user before this module is useable. type (individual_attribs) :: individual_attributes type (individual) :: empty_individual !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Interface definition: !The following interface allows the comparison of individuals by means of a !check for equality ('==' or '.eq'). interface operator (.eq.) module procedure findividual_compare end interface !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! The following are shorthand functions for accessing genetic data. ! The shorthand functions provide a means of accessing data without the need ! to reference through the hierarchy of data types ! ! For example, ! value = forientation(pop, 1, 2, 3, 4) ! is tantamount to ! value = population%subpopulation_array(1)%individual_array(2)% & ! laminate_array(3)%ply_array(4)%orientation . ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function FINDIVIDUAL (POPULATION, J, K) result (VALUE) ! !Function findividual returns the specified individual from the population. ! ! On input: ! ! POPULARTION specifies the population the individual is in. ! ! J specifies the subpopulation number in the population. ! ! K specifies the individual number in the subpopulation. ! ! On output: ! ! VALUE is the specified individual, of type (individual). ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (popltn) :: population type (individual) :: value integer ::j, k value = population%subpopulation_array(j)%individual_array(k) return end function FINDIVIDUAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function FORIENTATION (POPULATION, J, K, M, N) result (VALUE) ! ! Function FORIENTATION returns the orientation value for the specified ! individual. ! ! On input: ! ! POPULATION specifies the population the individual is in. population is of ! type (population), defined in this module. ! ! J specifies the subpopulation number in the population. ! ! K specifies the individual number in the subpopulation. ! ! M specifies the the laminate number in the individual. ! ! N specifies the ply number in the laminate. ! ! On output: ! ! VALUE is the specified orientation, of type integer. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (popltn) :: population integer :: j, k, m, n integer (KIND=small) :: value value = population%subpopulation_array(j)%individual_array(k)% & laminate_array(m)%ply_array(n)%orientation return end function FORIENTATION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function FMATERIAL(POPULATION, J, K, M, N) result (VALUE) ! ! Function FMATERIAL returns the material value for the specified individual. ! ! On input: ! ! POPULATION specifies the population the individual is in. ! ! J specifies the subpopulation number in the population. ! ! K specifies the individual number in the subpopulation. ! ! M specifies the the laminate number in the individual. ! ! N specifies the ply number in the laminate. ! ! On output: ! ! VALUE is the specified material, of type integer. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (popltn) :: population integer :: j, k, m, n integer (KIND=small) :: value value = population%subpopulation_array(j)%individual_array(k)% & laminate_array(m)%ply_array(n)%material return end function FMATERIAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function FGEOMETRY(POPULATION, J, K, M, N) result (VALUE) ! ! Function FGEOMETRY returns the geometry value for the specified individual. ! ! On input: ! ! POPULATION specifies the population the individual is in. ! ! J specifies the subpopulation number in the population. ! ! K specifies the individual number in the subpopulation. ! ! M specifies the the geometry chromosome number in the individual. ! ! N specifies the geometry gene number in the laminate. ! ! On output: ! ! VALUE is the specified geometry value, of type real. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (popltn) :: population integer :: j, k, m, n real (KIND=R8) :: value value = population%subpopulation_array(j)%individual_array(k)% & geometry_array(m)%geometry_gene_array(n)%digit return end function FGEOMETRY !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function FSTRUCTURE(POPULATION, J, K) result (VALUE) ! ! Function FSTRUCTURE returns an individual structure from the population. ! ! On input: ! ! POPULATION specifies the population the individual is in. ! ! J specifies the subpopulation number in the population. ! ! K specifies the individual number in the subpopulation. ! ! On output: ! ! VALUE is the specified individual structure, of type (individual). ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (popltn) :: population type (individual):: value integer :: j, k value = population%subpopulation_array(j)%individual_array(k) return end function FSTRUCTURE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !End shorthand functions. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function FINDIVIDUAL_COMPARE(STRUCT1, STRUCT2) result (IND_VALUE) ! ! Function FINDIVIDUAL_COMPARE compares two individuals (structures) ! for equality. ! ! On input: ! ! STRUCT1 is the first individual to compare. ! ! STRUCT2 is the second individual to compare. ! ! On output: ! ! IND_VALUE is .TRUE. if the structures are identical, or ! is .FALSE. if the structures differ in at least one material ! or orientation. ! ! NOTE : This function is also accessed through the interface operator (.eq.), ! which enables the function to be used as a binary (infix) operator ! ! For example, ! if (child1 == child2) then ... ! and ! if (child1 .eq. child2) then ... ! are equivalent to ! if (findividual_compare(child1, child2)) then ... ! ! NOTE : This function only compares orientations and material types, not ! continuous (geometry) variables ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !struct1 and struct2 are intent in to enable access through an interface. type (individual), intent(in) :: struct1 type (individual), intent(in) :: struct2 logical :: ind_value !Local variables: integer :: L, M ind_value = .TRUE. Lloop:do L = 1, individual_attributes%individual_size_lam Mloop: do M=1,individual_attributes%laminate_definition_array(L)% & laminate_size if (.NOT.((struct1%laminate_array(L)%ply_array(M)%orientation== & struct2%laminate_array(L)%ply_array(M)%orientation) .and. & (struct1%laminate_array(L)%ply_array(M)%material == & struct2%laminate_array(L)%ply_array(M)%material))) & then ind_value = .FALSE. exit Mloop end if end do Mloop end do Lloop if(ind_value) then LloopG:do L = 1, individual_attributes%individual_size_geom MloopG:do M = 1,individual_attributes%geometry_definition_array(L)% & geom_chromo_size if (.NOT.(struct1%geometry_array(L)%geometry_gene_array(M)% & digit == struct2%geometry_array(L)%geometry_gene_array(M)% & digit)) & then ind_value = .FALSE. exit MloopG end if end do MloopG end do LloopG else return endif return end function FINDIVIDUAL_COMPARE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function CREATE_CHILD() result(CHILD) ! !Function CREATE_CHILD creates a new structure. ! ! On input: ! ! Data necessary to define a new individual is available in the ! individual_attributes variable, defined in this module, and initialized ! in a user program ! ! On output: ! ! CHILD is a new individual, of type (individual), ! with all values initialized to zero. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (individual) :: child !Local variables: integer :: subpopulation integer :: L, M, N, P !allocate laminates allocate (child%laminate_array(individual_attributes%individual_size_lam)) Lloop:do L=1, individual_attributes%individual_size_lam allocate (child%laminate_array(L)%ply_array( & individual_attributes%laminate_definition_array(L)% & laminate_size)) Mloop:do M=1, individual_attributes%laminate_definition_array(L)% & laminate_size child%laminate_array(L)%ply_array(M)%orientation = 0 child%laminate_array(L)%ply_array(M)%material = 0 end do Mloop end do Lloop !allocate geometries allocate (child%geometry_array(individual_attributes% & individual_size_geom)) Nloop:do N=1, individual_attributes%individual_size_geom allocate (child%geometry_array(N)%geometry_gene_array( & individual_attributes%geometry_definition_array(N)%geom_chromo_size)) Ploop:do P=1, individual_attributes%geometry_definition_array(N)% & geom_chromo_size child%geometry_array(N)%geometry_gene_array(P)%digit = 0 end do Ploop end do Nloop return end function CREATE_CHILD !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine INITIALIZE_POPULATION(POPULATION) ! ! Subroutine INITIALIZE_POPULATION creates and initializes a new population, ! with individuals created according to the variable, INDIVIDUAL_ATTRIBUTES. ! ! ! ! On input: ! ! Data necessary to define a population is available in the ! variables INDIVIDUAL_ATTRIBUTES, POPULATION_SIZE, and SUBPOPULATION_SIZE, ! defined in module GENERIC_GA, and initialized in a user program. ! Individual's gene values (geometry, material, and orientation) are ! initialized randomly according to INDIVIDUAL_ATTRIBUTES. ! ! ! On output: ! ! POPULATION is the initialized population, of type (popltn). ! ! ! Other functions and subroutines used: ! ! Function CREATE_CHILD creates individuals to be added to the population. ! ! Function FINDIVIDUAL_COMPARE is used to compare individuals for uniqueness. ! This function is accessed with the "==" operator, as defined in the ! interface block of this module. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (popltn), intent(out) :: POPULATION !Local variables: integer :: orientation, geom_gene_num integer :: J,K,L,M,N,P,Q, count real (KIND=R8) :: x1, x2, geom_digit real :: rnd logical :: unique_indiv empty_individual=create_child() !Allocate space for populations. allocate (population%subpopulation_array(population_size)) !Allocate space for subpopulations. Jloop:do J=1, population_size allocate (population%subpopulation_array(J)% & individual_array(subpopulation_size)) !Create a subpopulation of individuals. Kloop:do K=1, subpopulation_size population%subpopulation_array(J)%individual_array(K)= & create_child() count = 0 ! Count attempts to find unique child. unique:do !Check for uniqueness of each child w.r.t. the population. count = count + 1 !Randomly initialize ply genes. Lloop:do L=1, individual_attributes%individual_size_lam Mloop:do M=1, individual_attributes%laminate_definition_array(L)% & laminate_size call random_number(rnd) if (individual_attributes%laminate_definition_array(L)% & empty_plies .eqv. .FALSE.) then population%subpopulation_array(J)%individual_array(K)% & laminate_array(L)%ply_array(M)%orientation & =individual_attributes%laminate_definition_array(L)% & orientation_array(ceiling(rnd*individual_attributes% & laminate_definition_array(L)%num_poss_orientations)) else if (rnd < 1.0/(individual_attributes% & laminate_definition_array(L)%num_poss_orientations+1)) & then population%subpopulation_array(J)%individual_array(K)% & laminate_array(L)%ply_array(M)%orientation & = 0 ! empty ply else call random_number(rnd) population%subpopulation_array(J)%individual_array(K)% & laminate_array(L)%ply_array(M)%orientation & =individual_attributes%laminate_definition_array(L)% & orientation_array(ceiling(rnd*(individual_attributes% & laminate_definition_array(L)%num_poss_orientations )) ) endif endif if (forientation(population, J, K, L, M) == 0) then population%subpopulation_array(J)%individual_array(K)% & laminate_array(L)%ply_array(M)%material=0 else call random_number(rnd) population%subpopulation_array(J)%individual_array(K)% & laminate_array(L)%ply_array(M)%material & =individual_attributes%laminate_definition_array(L)% & material_array(ceiling(rnd*(individual_attributes% & laminate_definition_array(L)%num_materials )) ) endif end do Mloop population%subpopulation_array(J)%individual_array(K)% & laminate_array(L)%ply_array(1:) = & pack (population%subpopulation_array(J)%individual_array(K)% & laminate_array(L)%ply_array, mask = population%subpopulation_array(J)% & individual_array(K)%laminate_array(L)%ply_array%orientation .ne. 0, & vector = (empty_individual%laminate_array(L)%ply_array) ) end do Lloop !Randomly initialize geometry genes. Nloop:do N=1, individual_attributes%individual_size_geom Ploop: do P=1, individual_attributes%geometry_definition_array(N)% & geom_chromo_size x1 = individual_attributes%geometry_definition_array(N)% & lower_bounds_array(P) x2 = individual_attributes%geometry_definition_array(N)% & upper_bounds_array(P) call random_number(rnd) geom_digit = x1 + rnd*(x2-x1) population%subpopulation_array(J)%individual_array(K)% & geometry_array(N)%geometry_gene_array(P)%digit=geom_digit end do Ploop end do Nloop !Check for uniqueness against population. unique_indiv = .TRUE. Qloop: do Q=1,K-1 ! compare to all preceeding if ((population%subpopulation_array(J)%individual_array(K)) & == (population%subpopulation_array(J)%individual_array(Q))) then unique_indiv = .FALSE. exit Qloop end if end do Qloop if ((unique_indiv) .or. (count==200)) exit unique end do unique end do Kloop end do Jloop return end subroutine INITIALIZE_POPULATION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine RANDOMIZER(rand_int) ! ! Subroutine RANDOMIZER seeds the f90 random number generator. ! ! On Input: ! ! The seed for the random number generator is in this subprogram. No inputs ! are necessary. ! ! On output: ! ! There is no return value. The random number generator is initialized. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Local variables: integer, allocatable, dimension(:) :: seed integer :: seed_size , rand_int call random_seed (SIZE=seed_size) allocate (seed(seed_size)) seed=45*rand_int call random_seed (PUT=seed(1:seed_size)) return end subroutine RANDOMIZER !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module GENERIC_GA