source: trunk/LMDZ.COMMON/libf/evolution/metamorphism.F90 @ 3984

MODULE metamorphism

implicit none

! Different types of frost
type :: frost
    real :: h2o
    real :: co2
end type frost

! Frost retained by the PEM to give back to the PCM at the end
type(frost), dimension(:,:), allocatable :: frost4PCM

! Indices for frost taken from the PCM
integer :: iPCM_h2ofrost, iPCM_co2frost

!=======================================================================
contains
!=======================================================================

SUBROUTINE ini_frost_id(nqtot,noms)

implicit none

! Arguments
!----------
integer,                        intent(in) :: nqtot
character(*), dimension(nqtot), intent(in) :: noms

! Local variables
!----------------
integer :: i

! Code
!-----
! Initialization
iPCM_h2ofrost = -1
iPCM_co2frost = -1

! Getting the index
do i = 1,nqtot
    if (trim(noms(i)) == "h2o_ice") iPCM_h2ofrost = i
    if (trim(noms(i)) == "co2")     iPCM_co2frost = i
enddo

! Checking if everything has been found
if (iPCM_h2ofrost < 0) error stop 'ini_frost_id: H2O frost index not found!'
if (iPCM_co2frost < 0) error stop 'ini_frost_id: CO2 frost index not found!'

END SUBROUTINE ini_frost_id
!=======================================================================

SUBROUTINE compute_frost(ngrid,nslope,h2ofrost_PCM,min_h2ofrost,co2frost_PCM,min_co2frost)

implicit none

! Arguments
!----------
integer,                       intent(in) :: ngrid, nslope
real, dimension(ngrid,nslope), intent(in) :: h2ofrost_PCM, min_h2ofrost, co2frost_PCM, min_co2frost

! Local variables
!----------------

! Code
!-----
write(*,*) '> Computing frost to give back to the PCM'

! Allocation
call ini_frost(ngrid,nslope)

! Initialization
frost4PCM(:,:)%h2o = 0.
frost4PCM(:,:)%co2 = 0.

! Computation: frost for the PEM is the extra part of the PCM frost above the yearly minimum
where (h2ofrost_PCM(:,:) > 0.) frost4PCM(:,:)%h2o = h2ofrost_PCM(:,:) - min_h2ofrost(:,:)
where (co2frost_PCM(:,:) > 0.) frost4PCM(:,:)%co2 = co2frost_PCM(:,:) - min_co2frost(:,:)

END SUBROUTINE compute_frost
!=======================================================================

SUBROUTINE set_frost4PCM(PCMfrost)

implicit none

! Arguments
!----------
real, dimension(:,:,:), intent(inout) :: PCMfrost

! Local variables
!----------------

! Code
!-----
write(*,*) '> Reconstructing frost for the PCM'
PCMfrost(:,iPCM_h2ofrost,:) = frost4PCM(:,:)%h2o
PCMfrost(:,iPCM_co2frost,:) = frost4PCM(:,:)%co2

! Deallocation
call end_frost()

END SUBROUTINE set_frost4PCM
!=======================================================================

SUBROUTINE ini_frost(ngrid,nslope)

implicit none

! Arguments
!----------
integer, intent(in) :: ngrid, nslope

! Local variables
!----------------

! Code
!-----
if (.not. allocated(frost4PCM)) allocate(frost4PCM(ngrid,nslope))

END SUBROUTINE ini_frost
!=======================================================================

SUBROUTINE end_frost()

implicit none

! Arguments
!----------

! Local variables
!----------------

! Code
!-----
if (allocated(frost4PCM)) deallocate(frost4PCM)

END SUBROUTINE end_frost

END MODULE metamorphism