From bea2f2246437c76b49da24295264763644b6b46a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Riette?= <sebastien.riette@meteo.fr>
Date: Tue, 11 Jan 2022 16:31:38 +0100
Subject: [PATCH] SR 11/01/2022 compute_frac_ice
The 3 routines are merged into mode_compute_frac_ice
using optimisation (with pointers) developped by Ryad.
---
src/arome/gmkpack_ignored_files | 7 +
src/arome/micro/condensation.F90 | 4 +-
.../mpa/turb/internals/compute_frac_ice1d.F90 | 84 -----
.../mpa/turb/internals/compute_frac_ice2d.F90 | 75 -----
.../mpa/turb/internals/compute_frac_ice3d.F90 | 76 -----
src/arome/turb/compute_frac_ice1d.F90 | 83 -----
src/arome/turb/compute_frac_ice2d.F90 | 73 -----
src/arome/turb/compute_frac_ice3d.F90 | 76 -----
src/arome/turb/modi_compute_frac_ice.F90 | 33 --
src/arome/turb/modi_compute_frac_ice1d.F90 | 15 -
src/arome/turb/modi_compute_frac_ice3d.F90 | 15 -
src/arome/turb/shallow_mf.F90 | 5 +-
src/arome/turb/th_r_from_thl_rt_1d.F90 | 4 +-
src/common/micro/mode_compute_frac_ice.F90 | 146 +++++++++
src/common/micro/rain_ice.F90 | 11 +-
src/mesonh/micro/condensation.f90 | 4 +-
src/mesonh/turb/compute_frac_ice.f90 | 286 ------------------
src/mesonh/turb/shallow_mf.f90 | 5 +-
18 files changed, 172 insertions(+), 830 deletions(-)
delete mode 100644 src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice1d.F90
delete mode 100644 src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice2d.F90
delete mode 100644 src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice3d.F90
delete mode 100644 src/arome/turb/compute_frac_ice1d.F90
delete mode 100644 src/arome/turb/compute_frac_ice2d.F90
delete mode 100644 src/arome/turb/compute_frac_ice3d.F90
delete mode 100644 src/arome/turb/modi_compute_frac_ice.F90
delete mode 100644 src/arome/turb/modi_compute_frac_ice1d.F90
delete mode 100644 src/arome/turb/modi_compute_frac_ice3d.F90
create mode 100644 src/common/micro/mode_compute_frac_ice.F90
delete mode 100644 src/mesonh/turb/compute_frac_ice.f90
diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files
index 10c5e38ab..7621cb09a 100644
--- a/src/arome/gmkpack_ignored_files
+++ b/src/arome/gmkpack_ignored_files
@@ -85,3 +85,10 @@ phyex/micro/ini_budget.F90
phyex/micro/modd_budget.F90
phyex/micro/modi_budget.F90
phyex/micro/modi_ini_budget.F90
+phyex/turb/compute_frac_ice1d.F90
+phyex/turb/compute_frac_ice2d.F90
+phyex/turb/compute_frac_ice3d.F90
+phyex/turb/modi_compute_frac_ice.F90
+phyex/turb/modi_compute_frac_ice1d.F90
+phyex/turb/modi_compute_frac_ice3d.F90
+
diff --git a/src/arome/micro/condensation.F90 b/src/arome/micro/condensation.F90
index da5c6e905..a3033817e 100644
--- a/src/arome/micro/condensation.F90
+++ b/src/arome/micro/condensation.F90
@@ -76,7 +76,7 @@
!
USE MODD_CST
USE MODD_PARAMETERS
-USE MODI_COMPUTE_FRAC_ICE
+USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
USE MODD_TIWMX
USE MODI_ICECLOUD
USE MODI_TIWMX
@@ -321,7 +321,7 @@ ZFRAC(:,:,:) = 0.
WHERE(PRC(:,:,:)+PRI(:,:,:) > 1.E-20)
ZFRAC(:,:,:) = PRI(:,:,:) / (PRC(:,:,:)+PRI(:,:,:))
ENDWHERE
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE, ZFRAC, PT)
+CALL COMPUTE_FRAC_ICE(SIZE(ZFRAC, 1), SIZE(ZFRAC, 2), SIZE(ZFRAC, 3), HFRAC_ICE, ZFRAC, PT)
IF(.NOT. OUSERI) ZFRAC(:,:,:)=0.
IF(OCND2) ZFRAC=0.
!
diff --git a/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice1d.F90 b/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice1d.F90
deleted file mode 100644
index 07af7f515..000000000
--- a/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice1d.F90
+++ /dev/null
@@ -1,84 +0,0 @@
-! ######spl
- SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
-! ##########################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!! S. Riette 08/2016 add option O
-!! R. El Khatib 24-Aug-2021 Optimization by cache re-use + assume data is contiguous
-!!
-!! --------------------------------------------------------------------------
-! 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_NEB, ONLY : XTMINMIX, XTMAXMIX
-USE MODD_CST, ONLY : XTT
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, CONTIGUOUS, DIMENSION(:), INTENT(IN) :: PT ! temperature
-REAL, CONTIGUOUS, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!
-! 0.2 declaration of local variables
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! 0.2 initialisation
-!
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE1D',0,ZHOOK_HANDLE)
-!
-!------------------------------------------------------------------------
-! 1. Compute FRAC_ICE
-!
-SELECT CASE(HFRAC_ICE)
- CASE ('T') !using Temperature
- PFRAC_ICE(:) = MAX( 0., MIN(1., (( XTMAXMIX - PT(:) ) / ( XTMAXMIX - XTMINMIX )) ) ) ! freezing interval
- CASE ('O') !using Temperature with old formulae
- PFRAC_ICE(:) = MAX( 0., MIN(1., (( XTT - PT(:) ) / 40.) ) ) ! freezing interval
- CASE ('N') !No ice
- PFRAC_ICE(:) = 0.
- CASE ('S') !Same as previous
- ! (almost) nothing to do
- PFRAC_ICE(:) = MAX( 0., MIN(1., PFRAC_ICE(:) ) )
- CASE DEFAULT
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' INVALID OPTION IN COMPUTE_FRAC_ICE, HFRAC_ICE=',HFRAC_ICE
- CALL ABORT
- STOP
-END SELECT
-
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE1D',1,ZHOOK_HANDLE)
-
-END SUBROUTINE COMPUTE_FRAC_ICE1D
diff --git a/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice2d.F90 b/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice2d.F90
deleted file mode 100644
index f399e394f..000000000
--- a/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice2d.F90
+++ /dev/null
@@ -1,75 +0,0 @@
-! ######spl
- SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
-! ##########################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!! R. El Khatib 24-Aug-2021 Optimize by loop collapsing + assume data is contiguous
-!!
-!! --------------------------------------------------------------------------
-! 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODI_COMPUTE_FRAC_ICE1D
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, TARGET, CONTIGUOUS, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
-REAL, TARGET, CONTIGUOUS, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!-------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-REAL, POINTER, DIMENSION(:) :: ZT, ZFRAC_ICE
-
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------
-!
-! 0.3 Initialisation
-!
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE2D',0,ZHOOK_HANDLE)
-!
-!----------------------------------------------------------------------------
-!
-! 1 Compute FRAC_ICE
-! ----------------
-!
-ZT(1:SIZE(PT))=>PT
-ZFRAC_ICE(1:SIZE(PFRAC_ICE))=>PFRAC_ICE
-CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,ZFRAC_ICE,ZT)
-
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE2D',1,ZHOOK_HANDLE)
-
-END SUBROUTINE COMPUTE_FRAC_ICE2D
diff --git a/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice3d.F90 b/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice3d.F90
deleted file mode 100644
index 1834f72d8..000000000
--- a/src/arome/modset_Ryad/mpa/turb/internals/compute_frac_ice3d.F90
+++ /dev/null
@@ -1,76 +0,0 @@
-! ######spl
- SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
-! #################################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!! R. El Khatib 24-Aug-2021 Optimize by loop collapsing + assume data is contiguous
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODI_COMPUTE_FRAC_ICE1D
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, TARGET, CONTIGUOUS, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, TARGET, CONTIGUOUS, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!-------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-REAL, POINTER, DIMENSION(:) :: ZT, ZFRAC_ICE
-
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------
-!
-! 0.3 Initialisation
-!
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE3D',0,ZHOOK_HANDLE)
-!
-!----------------------------------------------------------------------------
-!
-! 1 Compute FRAC_ICE
-! ----------------
-!
-ZT(1:SIZE(PT))=>PT
-ZFRAC_ICE(1:SIZE(PFRAC_ICE))=>PFRAC_ICE
-CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,ZFRAC_ICE,ZT)
-
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE3D',1,ZHOOK_HANDLE)
-
-END SUBROUTINE COMPUTE_FRAC_ICE3D
diff --git a/src/arome/turb/compute_frac_ice1d.F90 b/src/arome/turb/compute_frac_ice1d.F90
deleted file mode 100644
index f06cd703e..000000000
--- a/src/arome/turb/compute_frac_ice1d.F90
+++ /dev/null
@@ -1,83 +0,0 @@
-! ######spl
- SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
-! ##########################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!! S. Riette 08/2016 add option O
-!!
-!! --------------------------------------------------------------------------
-! 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_NEB, ONLY : XTMINMIX, XTMAXMIX
-USE MODD_CST, ONLY : XTT
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, DIMENSION(:), INTENT(IN) :: PT ! temperature
-REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!
-! 0.2 declaration of local variables
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! 0.2 initialisation
-!
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE1D',0,ZHOOK_HANDLE)
-!
-!------------------------------------------------------------------------
-! 1. Compute FRAC_ICE
-!
-IF (HFRAC_ICE=='T') THEN !using Temperature
- PFRAC_ICE(:) = ( XTMAXMIX - PT(:) ) / ( XTMAXMIX - XTMINMIX ) ! freezing interval
-ELSEIF (HFRAC_ICE=='O') THEN !using Temperature with old formulae
- PFRAC_ICE(:) = ( XTT - PT(:) ) / 40. ! freezing interval
-ELSEIF (HFRAC_ICE=='N') THEN !No ice
- PFRAC_ICE(:) = 0.
-ELSEIF (HFRAC_ICE=='S') THEN !Same as previous
- !nothing to do
-ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' INVALID OPTION IN COMPUTE_FRAC_ICE, HFRAC_ICE=',HFRAC_ICE
- CALL ABORT
- STOP
-ENDIF
-
-PFRAC_ICE(:) = MAX( 0., MIN(1., PFRAC_ICE(:) ) )
-
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE1D',1,ZHOOK_HANDLE)
-
-END SUBROUTINE COMPUTE_FRAC_ICE1D
diff --git a/src/arome/turb/compute_frac_ice2d.F90 b/src/arome/turb/compute_frac_ice2d.F90
deleted file mode 100644
index 8dfca6d4a..000000000
--- a/src/arome/turb/compute_frac_ice2d.F90
+++ /dev/null
@@ -1,73 +0,0 @@
-! ######spl
- SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
-! ##########################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!!
-!! --------------------------------------------------------------------------
-! 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODI_COMPUTE_FRAC_ICE1D
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!-------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: JK
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------
-!
-! 0.3 Initialisation
-!
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE2D',0,ZHOOK_HANDLE)
-!
-!----------------------------------------------------------------------------
-!
-! 1 Compute FRAC_ICE
-! ----------------
-!
-DO JK=1, SIZE(PT,2)
- CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE(:,JK),PT(:,JK))
-ENDDO
-
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE2D',1,ZHOOK_HANDLE)
-
-END SUBROUTINE COMPUTE_FRAC_ICE2D
diff --git a/src/arome/turb/compute_frac_ice3d.F90 b/src/arome/turb/compute_frac_ice3d.F90
deleted file mode 100644
index 4a5b1a89f..000000000
--- a/src/arome/turb/compute_frac_ice3d.F90
+++ /dev/null
@@ -1,76 +0,0 @@
-! ######spl
- SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
-! #################################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODI_COMPUTE_FRAC_ICE1D
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!-------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: JJ, JK
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------
-!
-! 0.3 Initialisation
-!
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE3D',0,ZHOOK_HANDLE)
-!
-!----------------------------------------------------------------------------
-!
-! 1 Compute FRAC_ICE
-! ----------------
-!
-DO JK=1, SIZE(PT,3)
- DO JJ=1, SIZE(PT,2)
- CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE(:,JJ,JK),PT(:,JJ,JK))
- ENDDO
-ENDDO
-
-IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE3D',1,ZHOOK_HANDLE)
-
-END SUBROUTINE COMPUTE_FRAC_ICE3D
diff --git a/src/arome/turb/modi_compute_frac_ice.F90 b/src/arome/turb/modi_compute_frac_ice.F90
deleted file mode 100644
index 89238dc3d..000000000
--- a/src/arome/turb/modi_compute_frac_ice.F90
+++ /dev/null
@@ -1,33 +0,0 @@
-! ######spl
- MODULE MODI_COMPUTE_FRAC_ICE
-! ############################
-!
-INTERFACE COMPUTE_FRAC_ICE
-!
- SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
-!
- END SUBROUTINE COMPUTE_FRAC_ICE3D
-!
- SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:), INTENT(IN) :: PT
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE
-!
- END SUBROUTINE COMPUTE_FRAC_ICE2D
-
- SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:), INTENT(IN) :: PT
-REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
-
- END SUBROUTINE COMPUTE_FRAC_ICE1D
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_FRAC_ICE
diff --git a/src/arome/turb/modi_compute_frac_ice1d.F90 b/src/arome/turb/modi_compute_frac_ice1d.F90
deleted file mode 100644
index 863787fd3..000000000
--- a/src/arome/turb/modi_compute_frac_ice1d.F90
+++ /dev/null
@@ -1,15 +0,0 @@
-! ######spl
- MODULE MODI_COMPUTE_FRAC_ICE1D
-! ##############################
-
-INTERFACE
-!
- SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:), INTENT(IN) :: PT
-REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
-!
- END SUBROUTINE COMPUTE_FRAC_ICE1D
-END INTERFACE
-END MODULE MODI_COMPUTE_FRAC_ICE1D
diff --git a/src/arome/turb/modi_compute_frac_ice3d.F90 b/src/arome/turb/modi_compute_frac_ice3d.F90
deleted file mode 100644
index fb3b0cc93..000000000
--- a/src/arome/turb/modi_compute_frac_ice3d.F90
+++ /dev/null
@@ -1,15 +0,0 @@
-! ######spl
- MODULE MODI_COMPUTE_FRAC_ICE3D
-! ##############################
-
-INTERFACE
-!
- SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
-!
- END SUBROUTINE COMPUTE_FRAC_ICE3D
-END INTERFACE
-END MODULE MODI_COMPUTE_FRAC_ICE3D
diff --git a/src/arome/turb/shallow_mf.F90 b/src/arome/turb/shallow_mf.F90
index 1173fc67f..03c55548d 100644
--- a/src/arome/turb/shallow_mf.F90
+++ b/src/arome/turb/shallow_mf.F90
@@ -70,7 +70,7 @@ USE MODI_COMPUTE_UPDRAFT_RAHA
USE MODI_MF_TURB
USE MODI_MF_TURB_EXPL
USE MODI_COMPUTE_MF_CLOUD
-USE MODI_COMPUTE_FRAC_ICE
+USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
!
IMPLICIT NONE
@@ -186,7 +186,8 @@ ZFRAC_ICE(:,:) = 0.
WHERE(PRM(:,:,2)+PRM(:,:,4) > 1.E-20)
ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4))
ENDWHERE
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:))
+CALL COMPUTE_FRAC_ICE(SIZE(ZFRAC_ICE, 1), SIZE(ZFRAC_ICE, 2), &
+ HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:))
! Conservative variables at t-dt
CALL THL_RT_FROM_TH_R_MF(KRR,KRRL,KRRI, &
diff --git a/src/arome/turb/th_r_from_thl_rt_1d.F90 b/src/arome/turb/th_r_from_thl_rt_1d.F90
index 5a17d2569..6add0bb64 100644
--- a/src/arome/turb/th_r_from_thl_rt_1d.F90
+++ b/src/arome/turb/th_r_from_thl_rt_1d.F90
@@ -43,7 +43,7 @@
!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODI_COMPUTE_FRAC_ICE
+USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
USE MODD_CST!, ONLY: XP00, XRD, XCPD, XCPV, XCL, XCI, XLVTT, XTT, XLSTT
USE MODE_THERMO
!
@@ -127,7 +127,7 @@ DO II=1,JITER
PFRAC_ICE(J) = PRI(J) / (PRL(J)+PRI(J))
ENDIF
ENDDO
- CALL COMPUTE_FRAC_ICE(HFRAC_ICE,PFRAC_ICE(:),ZT(:))
+ CALL COMPUTE_FRAC_ICE(SIZE(PFRAC_ICE, 1), HFRAC_ICE,PFRAC_ICE(:),ZT(:))
!Computation of Rvsat and dRsat/dT
!In this version QSAT, QSATI, DQSAT and DQASATI functions are not used
diff --git a/src/common/micro/mode_compute_frac_ice.F90 b/src/common/micro/mode_compute_frac_ice.F90
new file mode 100644
index 000000000..6ebe4a28d
--- /dev/null
+++ b/src/common/micro/mode_compute_frac_ice.F90
@@ -0,0 +1,146 @@
+!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODE_COMPUTE_FRAC_ICE
+! ############################
+!
+!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Julien PERGAUD * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/03/06
+!! S. Riette April 2011 optimisation
+!! S. Riette 08/2016 add option O
+!! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!! R. El Khatib 24-Aug-2021 Optimization by cache re-use + assume data is contiguous
+!! S. Riette Jan-2022 Merge the 3 procedures in one module + array shape declaration
+!
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+INTERFACE COMPUTE_FRAC_ICE
+ MODULE PROCEDURE COMPUTE_FRAC_ICE1D, COMPUTE_FRAC_ICE2D, COMPUTE_FRAC_ICE3D
+END INTERFACE COMPUTE_FRAC_ICE
+
+CONTAINS
+
+!! ==========
+!! 3D version
+!! ==========
+!
+SUBROUTINE COMPUTE_FRAC_ICE3D(KIT, KJT, KKT, HFRAC_ICE, PFRAC_ICE, PT)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KIT, KJT, KKT
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
+REAL, TARGET, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature
+REAL, TARGET, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
+REAL, POINTER, DIMENSION(:) :: ZT, ZFRAC_ICE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE3D',0,ZHOOK_HANDLE)
+!
+ZT(1:SIZE(PT))=>PT
+ZFRAC_ICE(1:SIZE(PFRAC_ICE))=>PFRAC_ICE
+CALL COMPUTE_FRAC_ICE1D(SIZE(PT), HFRAC_ICE,ZFRAC_ICE,ZT)
+!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE3D',1,ZHOOK_HANDLE)
+END SUBROUTINE COMPUTE_FRAC_ICE3D
+!
+!
+!! ==========
+!! 2D version
+!! ==========
+!
+SUBROUTINE COMPUTE_FRAC_ICE2D(KIT, KJT, HFRAC_ICE, PFRAC_ICE, PT)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KIT, KJT
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
+REAL, TARGET, DIMENSION(KIT,KJT), INTENT(IN) :: PT ! Temperature
+REAL, TARGET, DIMENSION(KIT,KJT), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
+REAL, POINTER, DIMENSION(:) :: ZT, ZFRAC_ICE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE2D',0,ZHOOK_HANDLE)
+!
+ZT(1:SIZE(PT))=>PT
+ZFRAC_ICE(1:SIZE(PFRAC_ICE))=>PFRAC_ICE
+CALL COMPUTE_FRAC_ICE1D(SIZE(PT), HFRAC_ICE,ZFRAC_ICE,ZT)
+!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE2D',1,ZHOOK_HANDLE)
+END SUBROUTINE COMPUTE_FRAC_ICE2D
+!
+!
+!! ==========
+!! 1D version
+!! ==========
+!
+SUBROUTINE COMPUTE_FRAC_ICE1D(KIT, HFRAC_ICE, PFRAC_ICE, PT)
+!! --------------------------------------------------------------------------
+! 0. DECLARATIONS
+! ------------
+!
+USE MODD_NEB, ONLY : XTMINMIX, XTMAXMIX
+USE MODD_CST, ONLY : XTT
+USE MODE_MSG, ONLY : PRINT_MSG, NVERB_FATAL
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KIT
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
+REAL, TARGET, DIMENSION(KIT), INTENT(IN) :: PT ! Temperature
+REAL, TARGET, DIMENSION(KIT), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
+!
+! 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE1D',0,ZHOOK_HANDLE)
+!------------------------------------------------------------------------
+! 1. Compute FRAC_ICE
+!
+SELECT CASE(HFRAC_ICE)
+ CASE ('T') !using Temperature
+ PFRAC_ICE(:) = MAX( 0., MIN(1., (( XTMAXMIX - PT(:) ) / ( XTMAXMIX - XTMINMIX )) ) ) ! freezing interval
+ CASE ('O') !using Temperature with old formulae
+ PFRAC_ICE(:) = MAX( 0., MIN(1., (( XTT - PT(:) ) / 40.) ) ) ! freezing interval
+ CASE ('N') !No ice
+ PFRAC_ICE(:) = 0.
+ CASE ('S') !Same as previous
+ ! (almost) nothing to do
+ PFRAC_ICE(:) = MAX( 0., MIN(1., PFRAC_ICE(:) ) )
+ CASE DEFAULT
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'COMPUTE_FRAC_ICE', 'invalid option for HFRAC_ICE='//HFRAC_ICE)
+END SELECT
+!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_FRAC_ICE1D',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE COMPUTE_FRAC_ICE1D
+!
+END MODULE MODE_COMPUTE_FRAC_ICE
diff --git a/src/common/micro/rain_ice.F90 b/src/common/micro/rain_ice.F90
index 952e54e53..b75c0de45 100644
--- a/src/common/micro/rain_ice.F90
+++ b/src/common/micro/rain_ice.F90
@@ -411,6 +411,7 @@ REAL, DIMENSION(KPROMA) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio
!
!For mixing-ratio-splitting
LOGICAL :: LLCPZ0RT
+REAL :: ZTIME_THRESHOLD1D(KPROMA) ! Time to reach threshold
REAL, DIMENSION(KPROMA, KRR) :: Z0RT ! Mixing-ratios at the beginig of the current loop
!
REAL, DIMENSION(KPROMA,0:7) :: &
@@ -974,12 +975,14 @@ IF (KSIZE > 0) THEN
IF (LLCPZ0RT) Z0RT(1:IMICRO, JV)=ZVART(1:IMICRO, JV)
DO JL=1, IMICRO
IF (IITER(JL)<INB_ITER_MAX .AND. ABS(ZA(JL,JV))>1.E-20) THEN
- ZTIME_THRESHOLD=(SIGN(1., ZA(JL, JV))*XMRSTEP+Z0RT(JL, JV)-ZVART(JL, JV)-ZB(JL, JV))/ZA(JL, JV)
+ ZTIME_THRESHOLD1D(JL)=(SIGN(1., ZA(JL, JV))*XMRSTEP+Z0RT(JL, JV)-ZVART(JL, JV)-ZB(JL, JV))/ZA(JL, JV)
ELSE
- ZTIME_THRESHOLD=-1.
+ ZTIME_THRESHOLD1D(JL)=-1.
ENDIF
- IF (ZTIME_THRESHOLD>=0 .AND. ZTIME_THRESHOLD<ZMAXTIME(JL) .AND. (ZVART(JL, JV)>XRTMIN(JV) .OR. ZA(JL, JV)>0.)) THEN
- ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD)
+ ENDDO
+ DO JL=1, IMICRO
+ IF (ZTIME_THRESHOLD1D(JL)>=0 .AND. ZTIME_THRESHOLD1D(JL)<ZMAXTIME(JL) .AND. (ZVART(JL, JV)>XRTMIN(JV) .OR. ZA(JL, JV)>0.)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD1D(JL))
ZCOMPUTE(JL)=0.
ENDIF
ENDDO
diff --git a/src/mesonh/micro/condensation.f90 b/src/mesonh/micro/condensation.f90
index ec60d4067..d0c88e2a3 100644
--- a/src/mesonh/micro/condensation.f90
+++ b/src/mesonh/micro/condensation.f90
@@ -138,7 +138,7 @@ USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
!
use mode_msg
!
-USE MODI_COMPUTE_FRAC_ICE
+USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
!
!
IMPLICIT NONE
@@ -332,7 +332,7 @@ IF (OUSERI) THEN
WHERE(PRC(:,:,:)+PRI(:,:,:) > 1.E-20)
ZFRAC(:,:,:) = PRI(:,:,:) / (PRC(:,:,:)+PRI(:,:,:))
ENDWHERE
- CALL COMPUTE_FRAC_ICE(HFRAC_ICE, ZFRAC, PT)
+ CALL COMPUTE_FRAC_ICE(SIZE(ZFRAC, 1), SIZE(ZFRAC, 2), SIZE(ZFRAC, 3), HFRAC_ICE, ZFRAC, PT)
ENDIF
!
DO JK=IKTB,IKTE
diff --git a/src/mesonh/turb/compute_frac_ice.f90 b/src/mesonh/turb/compute_frac_ice.f90
deleted file mode 100644
index b0e8e7b2d..000000000
--- a/src/mesonh/turb/compute_frac_ice.f90
+++ /dev/null
@@ -1,286 +0,0 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_COMPUTE_FRAC_ICE
-! ############################
-!
-INTERFACE COMPUTE_FRAC_ICE
-!
- SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
-!
- END SUBROUTINE COMPUTE_FRAC_ICE3D
-!
- SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:), INTENT(IN) :: PT
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE
-!
- END SUBROUTINE COMPUTE_FRAC_ICE2D
-
- SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:), INTENT(IN) :: PT
-REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
-
- END SUBROUTINE COMPUTE_FRAC_ICE1D
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_FRAC_ICE
-!
-! ##############################
- MODULE MODI_COMPUTE_FRAC_ICE3D
-! ##############################
-
-INTERFACE
-!
- SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
-!
- END SUBROUTINE COMPUTE_FRAC_ICE3D
-END INTERFACE
-END MODULE MODI_COMPUTE_FRAC_ICE3D
-!
-! ##############################
- MODULE MODI_COMPUTE_FRAC_ICE1D
-! ##############################
-
-INTERFACE
-!
- SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
-!
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:), INTENT(IN) :: PT
-REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
-!
- END SUBROUTINE COMPUTE_FRAC_ICE1D
-END INTERFACE
-END MODULE MODI_COMPUTE_FRAC_ICE1D
-! ##########################################################
- SUBROUTINE COMPUTE_FRAC_ICE3D(HFRAC_ICE,PFRAC_ICE,PT)
-! #################################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_COMPUTE_FRAC_ICE1D
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!-------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: JJ, JK
-!-------------------------------------------------------------------------
-!
-! 0.3 Initialisation
-!
-!
-!----------------------------------------------------------------------------
-!
-! 1 Compute FRAC_ICE
-! ----------------
-!
-DO JK=1, SIZE(PT,3)
- DO JJ=1, SIZE(PT,2)
- CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE(:,JJ,JK),PT(:,JJ,JK))
- ENDDO
-ENDDO
-
-
-END SUBROUTINE COMPUTE_FRAC_ICE3D
-! ##########################################################
- SUBROUTINE COMPUTE_FRAC_ICE2D(HFRAC_ICE,PFRAC_ICE,PT)
-! ##########################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!!
-!! --------------------------------------------------------------------------
-! 0. DECLARATIONS
-! ------------
-!
-USE MODI_COMPUTE_FRAC_ICE1D
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!-------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: JK
-!-------------------------------------------------------------------------
-!
-! 0.3 Initialisation
-!
-!
-!----------------------------------------------------------------------------
-!
-! 1 Compute FRAC_ICE
-! ----------------
-!
-DO JK=1, SIZE(PT,2)
- CALL COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE(:,JK),PT(:,JK))
-ENDDO
-
-
-END SUBROUTINE COMPUTE_FRAC_ICE2D
-! ##########################################################
- SUBROUTINE COMPUTE_FRAC_ICE1D(HFRAC_ICE,PFRAC_ICE,PT)
-! ##########################################################
-!
-!
-!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Julien PERGAUD * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/03/06
-!! S. Riette April 2011 optimisation
-!! S. Riette 08/2016 add option O
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!! --------------------------------------------------------------------------
-! 0. DECLARATIONS
-! ------------
-!
-USE MODD_NEB, ONLY : XTMINMIX, XTMAXMIX
-USE MODD_CST, ONLY : XTT
-USE MODE_MSG
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
-REAL, DIMENSION(:), INTENT(IN) :: PT ! temperature
-REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
-!
-! 0.2 declaration of local variables
-!
-!
-! 0.2 initialisation
-!
-!
-!------------------------------------------------------------------------
-! 1. Compute FRAC_ICE
-!
-IF (HFRAC_ICE=='T') THEN !using Temperature
- PFRAC_ICE(:) = ( XTMAXMIX - PT(:) ) / ( XTMAXMIX - XTMINMIX ) ! freezing interval
-ELSEIF (HFRAC_ICE=='O') THEN !using Temperature with old formulae
- PFRAC_ICE(:) = ( XTT - PT(:) ) / 40. ! freezing interval
-ELSEIF (HFRAC_ICE=='N') THEN !No ice
- PFRAC_ICE(:) = 0.
-ELSEIF (HFRAC_ICE=='S') THEN !Same as previous
- !nothing to do
-ELSE
- call Print_msg(NVERB_FATAL,'GEN','COMPUTE_FRAC_ICE','invalid option for HFRAC_ICE='//HFRAC_ICE)
-ENDIF
-
-PFRAC_ICE(:) = MAX( 0., MIN(1., PFRAC_ICE(:) ) )
-
-
-END SUBROUTINE COMPUTE_FRAC_ICE1D
diff --git a/src/mesonh/turb/shallow_mf.f90 b/src/mesonh/turb/shallow_mf.f90
index 2ae315ad5..6bf7075e2 100644
--- a/src/mesonh/turb/shallow_mf.f90
+++ b/src/mesonh/turb/shallow_mf.f90
@@ -188,7 +188,7 @@ USE MODI_MF_TURB
USE MODI_MF_TURB_EXPL
USE MODI_MF_TURB_GREYZONE
USE MODI_COMPUTE_MF_CLOUD
-USE MODI_COMPUTE_FRAC_ICE
+USE MODE_COMPUTE_FRAC_ICE, ONLY : COMPUTE_FRAC_ICE
USE MODI_SHUMAN_MF
!
USE MODI_COMPUTE_BL89_ML
@@ -322,7 +322,8 @@ IF (SIZE(PRM,3).GE.4) THEN
ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4))
ENDWHERE
ENDIF
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:))
+CALL COMPUTE_FRAC_ICE(SIZE(ZFRAC_ICE, 1), SIZE(ZFRAC_ICE, 2), &
+ &HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:))
! Conservative variables at t-dt
CALL THL_RT_FROM_TH_R_MF(KRR,KRRL,KRRI, &
--
GitLab