program TEST !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! use GENERIC_GA ! This program uses module GENERIC_GA to implement the genetic ! algorithm !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! interface subroutine ANAL(subpopulation_size, individual , & orientation_array, & material_array, & laminate_size, & fitness_array, & geometry_array_x, & geometry_array_y, write) integer, parameter :: subpop_maxsize=500, laminate_maxsize=200 integer :: orientation_array(subpop_maxsize, laminate_maxsize), & material_array(subpop_maxsize, laminate_maxsize), & subpopulation_size, individual, laminate_size double precision :: geometry_array_x(subpop_maxsize), & geometry_array_y(subpop_maxsize) logical :: write double precision :: fitness_array (subpop_maxsize) end subroutine ANAL ! end interface !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer, parameter:: ga_infile = 10 !Input file unit number. !Logical parameters used to specify actions in subroutines: logical, parameter:: MINIMIZE = .TRUE., MAXIMIZE = .FALSE., & WRITE = .TRUE., NOWRITE = .FALSE. !Loop variables: integer ::i,j !The seed used to initialize the normal variate subprogram: integer :: iseed = 8675309 !The number of times to repeat the optimization loop: integer :: iterations !The populations used in optimization: type (popltn) population, child_population !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Create a namelist definition for reading the number of iterations for the !GA optimization loop: namelist / optimization_loop / iterations !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !The following variables are used for storing population rank and fitness !information, and interval information for selection. They are later !allocated to fit the population size and subpopulation size. integer, allocatable, dimension(:,:) :: parent_rank_array, & child_rank_array double precision, allocatable, dimension(:,:) :: parent_fitness_array, & child_fitness_array real (KIND = R8), allocatable, dimension(:) :: interval_array !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Open ga code input file: open(UNIT = ga_infile, FILE = 'two_mat_ga.in') read (ga_infile, nml = optimization_loop) !Open analysis code output file: open(UNIT = 2, FILE = 'results.out') !Initialize GA package random normal variate routine. !z= rstart(iseed) !Call the GA module initialization routine. call randomizer() !Read in GA information. call read_ga_input(ga_infile) !After reading in, allocate analysis arrays. allocate (interval_array(subpopulation_size)) allocate (parent_fitness_array(population_size, subpopulation_size)) allocate (child_fitness_array(population_size, subpopulation_size)) allocate (parent_rank_array(population_size, subpopulation_size)) allocate (child_rank_array(population_size, subpopulation_size)) !Initialize parent and child populations. call initialize_population(population) call initialize_population(child_population) !Initialize the interval array, used for selecting parents for !crossover. interval_array = roulette() !Analyze the initial parent population. call analyze_population(population,parent_fitness_array, NOWRITE) !Rank the initial parent population. call rank_population(parent_fitness_array, parent_rank_array, MINIMIZE) ! Begin optimization loop opt:do I = 1,iterations !Apply operators to the parent population. call apply_operators(population, parent_rank_array, child_population, & interval_array) !Analyze the child population. call analyze_population(child_population,child_fitness_array, NOWRITE) !Rank the child population. call rank_population(child_fitness_array, child_rank_array, MINIMIZE) !Use an elitist selection scheme to yield a new parent population. call elitist_selection(population, parent_fitness_array, & child_population, child_fitness_array) !Rank the new parent population. call rank_population(parent_fitness_array, parent_rank_array, MINIMIZE) do J=1, population_size write (*,*) 'iteration', I, 'pop', J,'best fitness', parent_fitness_array(J,1) end do write(*,*) end do opt !Call the final analysis with output. call analyze_population(population,parent_fitness_array, WRITE) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine READ_GA_INPUT(UNIT_NUM) ! ! Subroutine READ_GA_INPUT reads GA data from the specified file, ! UNIT_NUM. ! The GENERIC_GA module variable, INDIVIDUAL_ATTRIBUTES, is allocated and ! initialized according to this input. ! ! This subroutine follows closely the structure of the GENERIC_GA module ! variable, INDIVIDUAL_ATTRIBUTES. ! The specification is allowed of an individual of any size ! (i.e., number of laminate chromosomes, number of geometry chromosomes, ! number of plies in each laminate, number of geometry genes in each ! geometry chromosome), and a population of any size. ! ! On input: ! ! UNIT_NUM is the unit assigned to the file from which the GA data is ! to be read. It is expected that the file has been opened and ! assigned to UNIT_NUM. ! ! ! On output: ! ! The GENERIC_GA module variable, INDIVIDUAL_ATTRIBUTES, is initialized. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer, intent(in) :: unit_num integer :: i,j,k,l,m integer :: individual_size_lam, & individual_size_geom, num_materials, num_ply_angles, & num_poss_orientations logical :: empty_plies integer :: lam_size, crossover_type, mutation_type, geom_chromo_size !probabilities real (KIND = R8) prob_crossover, prob_mut_orientation, prob_mut_material, & prob_ply_addition, prob_ply_deletion, prob_inter_ply_swap,& prob_intra_ply_swap, prob_permutation, prob_mutation integer, allocatable, dimension(:) :: laminate_size integer, allocatable, dimension(:) :: geometry_size !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Create a namelist for input from UNIT_NUM. namelist / population_sizes / population_size, subpopulation_size namelist / individual_sizes / individual_size_lam, individual_size_geom namelist / laminate_info / lam_size, empty_plies, & crossover_type, mutation_type namelist / geometry_chromo_size/ geom_chromo_size namelist / ply_angles / num_poss_orientations namelist / material_types / num_materials namelist / individual_prob / prob_inter_ply_swap namelist / laminate_prob / prob_crossover, prob_mut_orientation, & prob_mut_material, prob_ply_addition, & prob_ply_deletion, prob_intra_ply_swap, & prob_permutation namelist / geometry_prob / prob_crossover, prob_mutation !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Read GENERIC_GA population-related information from input. read (unit_num, nml = population_sizes) read (unit_num, nml = individual_sizes) read (unit_num, nml = individual_prob) !Create space for information for each laminate in a structure. allocate (individual_attributes%laminate_definition_array( & individual_size_lam)) individual_attributes%individual_size_lam = individual_size_lam !Read and initialize information for each laminate. Iloop: do I = 1, individual_size_lam read (unit_num, nml = laminate_info) individual_attributes%laminate_definition_array(I)% & laminate_size = lam_size individual_attributes%laminate_definition_array(I)% & empty_plies = empty_plies individual_attributes%laminate_definition_array(I)% & crossover_type = crossover_type read (unit_num, nml = laminate_prob) individual_attributes%laminate_definition_array(I)% & prob_crossover = prob_crossover individual_attributes%laminate_definition_array(I)% & mutation_type = mutation_type individual_attributes%laminate_definition_array(I)% & prob_mut_orientation = prob_mut_orientation individual_attributes%laminate_definition_array(I)% & prob_mut_material = prob_mut_material individual_attributes%laminate_definition_array(I)% & prob_ply_addition = prob_ply_addition individual_attributes%laminate_definition_array(I)% & prob_ply_deletion = prob_ply_deletion individual_attributes%laminate_definition_array(I)% & prob_intra_ply_swap = prob_intra_ply_swap individual_attributes%laminate_definition_array(I)% & prob_permutation = prob_permutation read (unit_num, nml = ply_angles) individual_attributes%laminate_definition_array(I)% & num_poss_orientations = num_poss_orientations !Create space for the orientation alphabet. allocate(individual_attributes%laminate_definition_array(I)% & orientation_array(num_poss_orientations)) !Read the orientation alphabet. Kloop: do K = 1, num_poss_orientations read (unit_num, *) individual_attributes% & laminate_definition_array(I)%orientation_array(K) end do Kloop read (unit_num, nml = material_types) individual_attributes%laminate_definition_array(I)% & num_materials = num_materials !Create spaced for the material alphabet. allocate(individual_attributes%laminate_definition_array(I)% & material_array(num_materials)) !Read the material alphabet. Lloop: do L = 1, num_materials read (unit_num, *) individual_attributes% & laminate_definition_array(I)%material_array(L) end do Lloop end do Iloop !Create space for geometry chromosomes. read (unit_num, nml = individual_sizes) individual_attributes% individual_size_geom = individual_size_geom allocate (individual_attributes% & geometry_definition_array(individual_size_geom)) !Read information for each geometry chromosome. Jloop:do J = 1, individual_size_geom read (unit_num, nml = geometry_prob) individual_attributes%geometry_definition_array(J)% & prob_mutation = prob_mutation individual_attributes%geometry_definition_array(J)% & prob_crossover = prob_crossover read (unit_num, nml = geometry_chromo_size) individual_attributes%geometry_definition_array(J)% & geom_chromo_size = geom_chromo_size !Create space for geometry gene limits. allocate (individual_attributes%geometry_definition_array(J)% & lower_bounds_array(geom_chromo_size)) allocate (individual_attributes%geometry_definition_array(J)% & upper_bounds_array(geom_chromo_size)) !Read in limits for geometry genes. Mloop: do M= 1, geom_chromo_size read (unit_num,*) & individual_attributes%geometry_definition_array(J)% & lower_bounds_array(M) , & individual_attributes%geometry_definition_array(J)% & upper_bounds_array(M) end do Mloop end do Jloop return end subroutine READ_GA_INPUT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine ANALYZE_POPULATION(POPULATION, FIT_ARRAY, WRITE) ! ! Subroutine ANALYZE_POPULATION initializes the fitness array for a ! population. It is from within this subroutine that external analysis ! code is called. ! Each member of the population is converted from the GENERIC_GA module ! representation to the representation required by the analysis code. ! In this case, an external FORTRAN 77 analysis routine, ANAL, is used. ! In order to use ANAL, each member of the population is converted to ! an array of orientation values, an array of material values, and two ! arrays of geometry values. ! ANAL returns an individual fitness value which is stored in FIT_ARRAY. ! ! On input: ! ! POPULATION is the population to be analyzed, of type (popltn). ! ! WRITE is a logical variable, determining whether analysis information ! is written to the analysis output file. ! If WRITE is .TRUE. then analysis information is written. ! If WRITE is .FALSE. then analysis information is not written. ! ! ! On output: ! ! FIT_ARRAY is a two-dimensional array containing the fitness values ! for the population. ! ! For example, ! If POPULATION has been initialized with a population size of 10, and ! a subpopulation size of 40, the fitness value, FIT_ARRAY(4, 7) ! contains the fitness value for individual 7 in subpopulation 4. ! ! Other subroutines called from this subroutine: ! ! ANAL (an external subroutine) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (popltn), intent(in) :: population logical, intent(in) :: write double precision, intent(out) :: fit_array(population_size, & subpopulation_size) !Local variables: !The following parameters are used to initialize arrays used to ! interface with the external analysis subroutines. The arrays are ! of fixed size per the F77 analysis routine used by this program. integer, parameter :: subpop_maxsize=500, laminate_maxsize=200 !The following arrays are used to interface to the F77 analysis !code. integer :: orientation_array(subpop_maxsize, laminate_maxsize), & material_array(subpop_maxsize, laminate_maxsize) double precision :: geometry_array_x(subpop_maxsize), & geometry_array_y(subpop_maxsize) ! integer :: I, subpop integer :: laminate_size pop:do subpop = 1, population_size if (write) write(2,500) 'RESULTS FOR SUBPOPULATION',subpop,':' laminate_size = individual_attributes%laminate_definition_array(1)% & laminate_size ILoop: do I = 1, subpopulation_size orientation_array(I, 1:laminate_size) & = population%subpopulation_array(subpop)%individual_array(I) & %laminate_array(1)%ply_array(1:laminate_size)%orientation orientation_array(I, laminate_size+1:laminate_maxsize)=0 material_array(I, 1:laminate_size) & = population%subpopulation_array(subpop)%individual_array(I) & %laminate_array(1)%ply_array(1:laminate_size)%material material_array(I, laminate_size+1:laminate_maxsize)=0 geometry_array_x(I) = population%subpopulation_array(subpop) & %individual_array(I)%geometry_array(1)%geometry_gene_array(1)%digit geometry_array_y(I) = population%subpopulation_array(subpop) & %individual_array(I)%geometry_array(1)%geometry_gene_array(2)%digit call ANAL(subpopulation_size,I , & orientation_array, & material_array, & individual_attributes%laminate_definition_array(1)% & laminate_size, & fit_array(subpop, :), & geometry_array_x, & geometry_array_y, write) end do ILoop end do pop return 500 FORMAT(/,A,1X,I2,A,/) end subroutine ANALYZE_POPULATION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine ELITIST_SELECTION(PARENT_POP, PARENT_FITNESS_ARRAY, & CHILD_POP, CHILD_FITNESS_ARRAY) ! ! Subroutine ELITIST_SELECTION is a selection routine then ensures that ! the GA converges to an optimal design by retaining the best individuals ! from generation to generation. All individuals except the least fit ! are copied from CHILD_POP into PARENT_POP, while the most fit individual in ! PARENT_POP is kept in PARENT_POP. ! ! On input: ! ! PARENT_POP is the parent population from the previous generation, of ! type (popltn). ! ! CHILD_POP is the child population from the previous generation, of ! type (popltn). ! ! ! On output: ! ! PARENT_POP contains the most fit individual of the original PARENT_POP ! and all but the least fit individuals from the original CHILD_POP. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (popltn), intent(inout) :: parent_pop type (popltn), intent(inout) :: child_pop double precision, intent(inout):: parent_fitness_array(population_size, & subpopulation_size), & child_fitness_array(population_size, & subpopulation_size) !Local variables: integer :: I , subpop type (individual) :: temp pop:do subpop = 1, population_size ! Keep the best parent. if (parent_rank_array(subpop,1) /= 1) then temp = population%subpopulation_array(subpop)%individual_array(1) population%subpopulation_array(subpop)%individual_array(1) = & population%subpopulation_array(subpop)%individual_array( & parent_rank_array(subpop,1)) population%subpopulation_array(subpop)%individual_array( & parent_rank_array(subpop,1)) = temp parent_fitness_array(subpop,1)=parent_fitness_array(subpop, & parent_rank_array(subpop,1)) end if ! Keep children ranked 1...(subpopulation_size-1). ILoop:do I = 1, (subpopulation_size-1) temp = population%subpopulation_array(subpop)%individual_array(I+1) population%subpopulation_array(subpop)%individual_array(I+1)= & child_population%subpopulation_array(subpop)%individual_array( & child_rank_array(subpop,I)) child_population%subpopulation_array(subpop)%individual_array( & child_rank_array(subpop,I))=temp ! Store fitness to prevent re-analysis parent_fitness_array(subpop,I+1)=child_fitness_array(subpop, & child_rank_array(subpop,I)) end do ILoop end do pop return end subroutine ELITIST_SELECTION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine RANK_POPULATION(FITNESS, RANK, MINIMIZE) ! ! Subroutine RANK_POPULATION takes an array of fitnesses for a population, ! and uses a quick sort to generate a rank array. The rank array ! holds the rank for each individual in the individual's respective ! subpopulation. ! ! On input: ! ! FITNESS is a two-dimensional array containing the fitness values ! for the population. ! ! For example, FIT_ARRAY(4, 7) contains the fitness value for individual ! 7 in subpopulation 4. ! ! ! On output: ! ! RANK is a two dimensional array holding the rank of each individual in ! each parent subpopulation. The nth rank array entry ! for any subpopulation will give the position in the subpopulation of the ! individual of rank n. ! There is a unique rank for each member of a subpopulation. ! ! For example, ! If RANK(3,1) is equal to 7, then the seventh ! individual in the parent subpopulation (subpopulation 3 in this example) ! has the highest rank (best fitness). ! ! Other subroutines called from this subroutine: ! ! QUICK_SORT ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! double precision, intent(in):: fitness(population_size, subpopulation_size) integer, intent(out) :: rank(population_size, subpopulation_size) logical, intent(in) :: minimize !Local variables: double precision :: temp_fitness(subpopulation_size) double precision :: x, max integer :: I, location, subpop pop:do subpop = 1, population_size !Check whether to minimize or maximize ranking. if (minimize) temp_fitness = -fitness(subpop,1:subpopulation_size) max = maxval (temp_fitness) + 1 !Prepare an initial rank array. rank(subpop,:)=(/(i,i=1,subpopulation_size)/) !Sort the fitnesses into a ranking. call quick_sort(temp_fitness, rank(subpop,:),1, subpopulation_size) end do pop return end subroutine RANK_POPULATION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! function ROULETTE() result(ROULETTE_ARRAY) ! ! Function ROULETTE generates a vector of intervals for use in selecting ! parents for crossover from a ranked population. The intervals ! correspond to the desired probabilities of choosing a parent of a ! given rank. ROULETTE ensures that the individual with the highest ! rank receives the largest interval. ! ! The roulette intervals are calculated as follows: ! ! I(n) = I(n-1) + (2*(P-N+1))/((P+1)*P) ! where ! P = subpopulation size ! n = individual's rank in the population; n ranges from (1...P) ! I(0) = 0.0 ! ! Thus, for a subpopulation of size 3, the three ROULETTE values are ! I(1) = 0.5000 ! I(2) = 0.8333 ! I(3) = 1.0000 ! ! and individual 1 is chosen for crossover with probability 0.5000 , ! individual 2 is chosen for crossover with probability (0.8333-0.5000) ! = 0.3333, and individual 3 is chosen for crossover with probability ! (1.0000 - 0.8333) = 0.1667. ! ! ! On input: ! ! The subpopulation size is taken from SUBPOPULATION_SIZE, a variable ! made accessible by module GENERIC_GA. ! ! On output: ! ! ROULETTE_ARRAY contains the real vector of interval values. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real (KIND=R8) :: roulette_array(subpopulation_size) !Local variables: integer :: I real (KIND=R8) :: real_value, real_subpop_size !A real-valued subpopulation size is needed for calculation. real_subpop_size = subpopulation_size !Calculate the base case. roulette_array(1)= & (2*(real_subpop_size))/((real_subpop_size+1)*real_subpop_size) !Iterate for the rest of the subpopulation values. pop:do I = 2, subpopulation_size roulette_array(I)=roulette_array(I-1) + & (2*(real_subpop_size-I+1))/((real_subpop_size+1)*real_subpop_size) end do pop end function ROULETTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! recursive subroutine QUICK_SORT(X,Y,L,R) ! ! Subroutine QUICK_SORT implements the quick sort algorithm. The ! subroutine partitions into two vectors the vector to be sorted, then ! recursively calls itself once for each partition. This repeats until ! each partition is sorted. ! ! On input: ! ! X is the double precision vector to be sorted. ! ! Y is the integer vector of subpopulation rankings, to be sorted. ! Typically, Y should initially be a vector with each value in ! the vector equal to its position in the vector. ! ! L is the position in the vector of the leftmost element. ! Typically, L is initially 1. ! ! R is the position in the vector of the rightmost element. ! Typically, R is initially equal to the vector length. ! ! ! On output: ! ! X is the sorted version of the original X. ! ! Y is a vector where each value Y(n) holds the position in the ! the original X of the nth value in the returned X. ! ! For example, if the original vectors are ! X= (0.2, 0.3, 0.1), ! Y= (1, 2, 3) ! then the returned vectors are ! X= (0.1, 0.2, 0.3) ! Y= (3, 1, 2) ! Thus, X is sorted, and Y gives the positions in the original ! X of each element of the returned X. ! ! Subroutines called by this subroutine: ! ! SWOP ! SWOP_INT ! QUICK_SORT ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer, intent(in) :: l,r double precision, intent(inout) :: x(r) integer, intent(inout) :: y(r) !Local variables: integer :: l1, r1 real :: temp ! if (l= x(l)) r1=r1-1 end do if (l1=r1) exit !Partition has been found. end do !Partition with x(l) at r1 call swop (x(l), x(r1)) call swop_int (y(l), y(r1)) !Quick sort the left partition. call quick_sort(x,y,l,r1-1) !Quick sort the right partition. call quick_sort(x,y,r1+1,r) end if return end subroutine QUICK_SORT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine SWOP(A,B) ! ! Subroutine SWOP swaps two real values. ! ! ! On input: ! ! A is the first value to be swapped. ! ! B is the second value to be swapped. ! ! ! On output: ! ! A is the original B. ! ! B is the original A. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! double precision, intent(inout) :: a,b !Local variable: double precision :: temp temp = a a=b b=temp return end subroutine SWOP !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine SWOP_INT(A,B) ! ! Subroutine SWOP_INT swaps two integer values. ! ! ! On input: ! ! A is the first value to be swapped. ! ! B is the second value to be swapped. ! ! ! On output: ! ! A is the original B. ! ! B is the original A. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer, intent(inout) :: a,b !Local variable: integer :: temp temp = a a=b b=temp return end subroutine SWOP_INT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end program TEST !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!