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

MODULE metamorphism
!-----------------------------------------------------------------------
! NAME
!     metamorphism
!
! DESCRIPTION
!     Module for managing frost variables.
!
! AUTHORS & DATE
!     JB Clement, 12/2025
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! MODULE VARIABLES
! ----------------
! 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)
!-----------------------------------------------------------------------
! NAME
!     ini_frost_id
!
! DESCRIPTION
!     Initialize frost indices from PCM variable names.
!
! AUTHORS & DATE
!     JB Clement, 12/2025
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
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)
!-----------------------------------------------------------------------
! NAME
!     compute_frost
!
! DESCRIPTION
!     Compute the frost to give back to the PCM.
!
! AUTHORS & DATE
!     JB Clement, 12/2025
!
! NOTES
!     Frost for the PEM is the extra part of the PCM frost above the
!     yearly minimum.
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

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

! 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)
!-----------------------------------------------------------------------
! NAME
!     set_frost4PCM
!
! DESCRIPTION
!     Reconstruct frost for the PCM from PEM computations.
!
! AUTHORS & DATE
!     JB Clement, 12/2025
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

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

! 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)
!-----------------------------------------------------------------------
! NAME
!     ini_frost
!
! DESCRIPTION
!     Initialize frost arrays.
!
! AUTHORS & DATE
!     JB Clement, 12/2025
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

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

! 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()
!-----------------------------------------------------------------------
! NAME
!     end_frost
!
! DESCRIPTION
!     Deallocate frost arrays.
!
! AUTHORS & DATE
!     JB Clement, 12/2025
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

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

END SUBROUTINE end_frost
!=======================================================================

END MODULE metamorphism