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

MODULE metamorphism

implicit none

! Different types of frost retained by the PEM to give back to the PCM at the end
real, dimension(:,:), allocatable :: h2o_frost4PCM
real, dimension(:,:), allocatable :: co2_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
h2o_frost4PCM(:,:) = 0.
co2_frost4PCM(:,:) = 0.

! Computation: frost for the PEM is the extra part of the PCM frost above the yearly minimum
where (h2ofrost_PCM(:,:) > 0.) h2o_frost4PCM(:,:) = h2ofrost_PCM(:,:) - min_h2ofrost(:,:)
where (co2frost_PCM(:,:) > 0.) co2_frost4PCM(:,:) = 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,:) = h2o_frost4PCM(:,:)
PCMfrost(:,iPCM_co2frost,:) = co2_frost4PCM(:,:)

! 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(h2o_frost4PCM)) allocate(h2o_frost4PCM(ngrid,nslope))
if (.not. allocated(co2_frost4PCM)) allocate(co2_frost4PCM(ngrid,nslope))

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

SUBROUTINE end_frost()

implicit none

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

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

! Code
!-----
if (allocated(h2o_frost4PCM)) deallocate(h2o_frost4PCM)
if (allocated(co2_frost4PCM)) deallocate(co2_frost4PCM)

END SUBROUTINE end_frost

END MODULE metamorphism