PART_MGMT.f90 4.06 KB

!=============================================================================!
!                                                                             !
!                       PARTICLES MANAGEMENT                                  !
!                                                                             ! 
!       Description: In this routine, if a lagrangian particle carry to       !
!                    much biomass, then it splits into two particles.         !
!                                                                             !
!=============================================================================!

        subroutine PART_MGMT(div,Fi)

        USE global_parameter                            !shared parameters

!_____________________________________________________________________________
!                               LOCAL PARAMETERS
!_____________________________________________________________________________


        IMPLICIT NONE

        double precision, allocatable           :: z_cell_av(:)
        double precision, allocatable           :: light_av(:)
        double precision, allocatable           :: Uptake_lag_av(:)
        double precision, allocatable           :: qlag_av(:)
        double precision, allocatable           :: Dphyto_lag_av(:)
        double precision, allocatable           :: uptlight_av(:)
        double precision, allocatable           :: weight_cell_av(:)
        double precision, allocatable           :: S_av(:)
        double precision, allocatable           :: weight_av(:)
        double precision, allocatable           :: Ncell_av(:)
        integer, intent(in)                     :: div
        integer                                 :: nbp
        double precision, dimension(100000),intent(in):: Fi



!_____________________________________________________________________________


        if(div.gt.0) then


        nbp=nbpart+div


        allocate(weight_av(nbpart))
        allocate(z_cell_av(nbpart))
        allocate(light_av(nbpart))
        allocate(Uptake_lag_av(nbpart))
        allocate(qlag_av(nbpart))
        allocate(Dphyto_lag_av(nbpart))
        allocate(uptlight_av(nbpart))
        allocate(weight_cell_av(nbpart))
        allocate(S_av(nbpart))
        allocate(Ncell_av(nbpart))
     

        z_cell_av=z_cell
        light_av=light
        Uptake_lag_av=Uptake_lag
        qlag_av=qlag
        Dphyto_lag_av=Dphyto_lag
        uptlight_av=uptlight
        weight_cell_av=weight_cell
        S_av=S
        weight_av=weight
        Ncell_av=Ncell_lag

        deallocate(weight)
        deallocate(z_cell)
        deallocate(light)
        deallocate(Uptake_lag)
        deallocate(qlag)
        deallocate(Dphyto_lag)
        deallocate(uptlight)
        deallocate(weight_cell)
        deallocate(S)
        deallocate(Ncell_lag)


        allocate(weight(nbp))
        allocate(z_cell(nbp))
        allocate(light(nbp))
        allocate(Uptake_lag(nbp))
        allocate(qlag(nbp))
        allocate(Dphyto_lag(nbp))
        allocate(uptlight(nbp))
        allocate(weight_cell(nbp))
        allocate(S(nbp))
        allocate(Ncell_lag(nbp))
 

        z_cell(1:nbpart)=z_cell_av
        qlag(1:nbpart)=qlag_av  
        S(1:nbpart)=S_av
        weight_cell(1:nbpart)=weight_cell_av
        weight(1:nbpart)=weight_av
        Ncell_lag(1:nbpart)=Ncell_av


        z_cell(nbpart+1:nbp)=z_cell(INT(Fi(1:div)))
        qlag(nbpart+1:nbp)=qlag(INT(Fi(1:div)))
        weight_cell(nbpart+1:nbp)=weight_cell(INT(Fi(1:div)))
        Ncell_lag(nbpart+1:nbp)=Ncell_lag(INT(Fi(1:div)))/2
        weight(nbpart+1:nbp)=weight(INT(Fi(1:div)))/2

       
        weight(INT(Fi(1:div)))=weight(INT(Fi(1:div)))/2
        Ncell_lag(INT(Fi(1:div)))=Ncell_lag(INT(Fi(1:div)))/2

        
        

        deallocate(weight_av)
        deallocate(z_cell_av)
        deallocate(light_av)
        deallocate(Uptake_lag_av)
        deallocate(qlag_av)
        deallocate(Dphyto_lag_av)
        deallocate(uptlight_av)
        deallocate(weight_cell_av)
        deallocate(S_av)

        nbpart=nbp


        end if

        end subroutine PART_MGMT