Skip to content
Snippets Groups Projects
Commit 2ff066b9 authored by RIETTE Sébastien's avatar RIETTE Sébastien
Browse files

Merge branch 'SR_clean_budget' into main

parents 5aa831ac 162e38c2
No related branches found
No related tags found
No related merge requests found
Showing
with 248 additions and 8568 deletions
Directory organisation: # OFFLINE COMPILATION
- the fcm subdirectory contains the fcm tool. In the PHYEX git repository, this directory is empty.
It will be populated on first call to the make\_fcm.sh script and content is not tracked by git. ## Directory organisation
- the fiat subdirectory contains the fiat package from the ECMWF. In the PHYEX git repository, this directory is empty.
It will be populated on first call to the make\_fcm.sh script and content is not tracked by git. The different directories are:
- the arch subdirectory contains architecture specific files. An alternative arch directory can be - the fcm subdirectory contains the fcm tool. In the PHYEX git repository, this directory is empty.
provided on the command line when calling the make\_fcm.sh script It will be populated on first call to the make\_fcm.sh script and content is not tracked by git.
- arch\_\* subdirectories are automatically created by the make\_fcm.sh script and are tracked by git. - the fiat subdirectory contains the fiat package from the ECMWF. In the PHYEX git repository, this directory is empty.
- the make\_fcm.sh script will: It will be populated on first call to the make\_fcm.sh script and content is not tracked by git.
- the arch subdirectory contains architecture specific files. An alternative arch directory can be
provided on the command line when calling the make\_fcm.sh script
- arch\_\* subdirectories are automatically created by the make\_fcm.sh script and are not tracked by git.
## Compilation
The make\_fcm.sh script will:
- populate the fcm and fiat directories on first call - populate the fcm and fiat directories on first call
- create the arch\_$ARCH directory, poulate it with arch specific files and a compilation script - create the arch\_$ARCH directory, poulate it with arch specific files and a compilation script
- execute the newly created compilation script - execute the newly created compilation script
......
This diff is collapsed.
...@@ -18,6 +18,8 @@ This build system has two dependencies (installation is done automatically by th ...@@ -18,6 +18,8 @@ This build system has two dependencies (installation is done automatically by th
The script build/with\_fcm/make\_fcm.sh uses a configuration file and build the library and test programs. The script build/with\_fcm/make\_fcm.sh uses a configuration file and build the library and test programs.
They can be found in the build/bin sudirectory in the architecture specific directory arch\_\<achitecture name\>. They can be found in the build/bin sudirectory in the architecture specific directory arch\_\<achitecture name\>.
Some more details can be found in [build/with\_fcm/README.md file](../build/with_fcm/README.md).
## TEST PROGRAM ## TEST PROGRAM
### Data generation ### Data generation
......
...@@ -20,11 +20,19 @@ Intégration de PHYEX dans des cycles/versions officielles: ...@@ -20,11 +20,19 @@ Intégration de PHYEX dans des cycles/versions officielles:
- Ces clés devront être supprimées - Ces clés devront être supprimées
- Répertoires ext - Répertoires ext
- Répertoire arome/ext et mesonh/ext contiennent les codes non PHYEX qu'il faut modifier dans le pack pour qu'il puisse être compilé. - Répertoire arome/ext et mesonh/ext contiennent les codes non PHYEX qu'il faut modifier dans le pack pour qu'il puisse être compilé.
- Ce répertoire devra être vidé à la fin du phasage, les modifications nécessaires ayadevront avoir été fournies par ailleurs - Ce répertoire devra être vidé à la fin du phasage, les modifications nécessaires devront avoir été fournies par ailleurs
- modd_spp_type est pour l'instant dans mpa/micro/externals mais n'est pas de la microphysique - Code AROME:
- supprimer les répertoires internals et modules de mpa/* qui sont repris par phyex
- supprimer les codes listés dans le fichier src/arome/gmkpack_ignored_files (ceux qui ne sont pas dans phyex)
- reprendre le code de src/arome/ext pour mettre à jour le code IAL
- déplacer dans mpa/conv: aro_convbu
- déplacer dans un nouveau mpa/aux: aro_startbu, aroini_budget, aro_suintbudget, aro_suintbudget_omp, aroini_cstmnh, aroini_frommpa, modd_spp_type
Merge pb: Merge pb:
- AROME plante sur belenos lorsque le pack est complètement recompilé, constaté sur le commit c5379296bf399f376bddf02da37b81021c134717 (modifié pour initialisé CTURBLEN)
- rain_ice_old a rebrancher dans Meso-NH - rain_ice_old a rebrancher dans Meso-NH
- LIMA à faire
- KFB ?
Pb identifiés à corriger plus tard: Pb identifiés à corriger plus tard:
- deposition devrait être déplacée dans ice4_tendencies - deposition devrait être déplacée dans ice4_tendencies
...@@ -38,16 +46,9 @@ Pb identifiés à corriger plus tard: ...@@ -38,16 +46,9 @@ Pb identifiés à corriger plus tard:
- sedimentation momentum non branchée - sedimentation momentum non branchée
- si possible, modifier ice4_sedimentation_split* dans le même esprit que stat - si possible, modifier ice4_sedimentation_split* dans le même esprit que stat
Budgets/DDH
- Le code dans budget_DDH devra être transféré dans mode_budget
- les routines arome specifiques aux budgets sont dans mpa/micro, il faudrait les mettre dans aux
- Le module modd_dyn n'est utilisé que pour les budgets, voir s'il peut être supprimé
- Le code des budgets devrait être revu: pas en phase avec celui de Méso-NH et phasage a priori
inutile car très peu de code semble réellement utile pour AROME
Enable mnh_expand with fcm build Enable mnh_expand with fcm build
Reprendre les différents outils en deux scripts principaux: Reprendre les différents outils en deux scripts principaux:
- outil pour reprendre toutes les fonctionnalités sur le code: filepp, MNH_Expand_Array, correct_indent.py, verify_mnh_expand.py et renommage - outil pour reprendre toutes les fonctionnalités sur le code: filepp, MNH_Expand_Array, correct_indent.py, verify_mnh_expand.py et renommage
- outil prep_code débarrassé du renommage pour ne faire que la gestion des commit et lancer la manipulation sur le code - outil prep_code débarrassé du renommage pour ne faire que la gestion des commit et lancer la manipulation sur le code
Il restera, à part, les scripts de comparaison des résultats (à moins qu'ils puissent être placés dans les check_commit correspondant) Il restera, à part, les scripts de comparaison des résultats (à moins qu'ils puissent être inlinés dans les check_commit correspondant)
! ######spl
! #####################################
SUBROUTINE BUDGET_DDH(PVARS,KBUDN,HBUVAR,YDDDH, YDLDDH, YDMDDH, LDISDIFF)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #####################################
!
!! BUDGET - routine to call the BUDGET routine for AROME.
!!
!! BEWARE THIS ROUTINE iS DIFFERENT FROM THE MNH ROUTINE BUDGET
!! EVEN IF IT WEARS THE SAME NAME !!!
!!
!! PURPOSE
!! -------
! This routine is an interface for the add_ddh subroutine.
! It converts the selected field into klev reversed vertical
! levels and attributes to the selected field are created.
!
!!** METHOD
!! ------
!!
!! 1st step: substract previous step (sequential approach in MNH)
!! 2nd step: reverse levels
!! 3rd step: multiplication by conversion factor for r-> q
!! or Theta-> T
!!
!! 4rd step: call to add_ddh now that the field has an Aladin shape
!!
!!
!! EXTERNAL
!! --------
!! ADD_FIELD_3D
!! INVERT_VLEV
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_INTBUDGET:
!!
!! PVARS_M(nlon,1,nlev,13) !13 different budgets
!! VARMULT(:,:,13) ! allows to convert variables
!!
!! REFERENCE
!! ---------
!! "New data flow for diagnostics in Arome/Arpege"
!!
!! AUTHOR
!! ------
!! O.Riviere 17/07/08 * Meteo France *
!!
!!
!! MODIFICATIONS
!! -------------
!! F.Voitus 16/05/17 : Introduction of new DDH superstructure for budget
!! S.Riette Jan 2022 : LDISDIFF case
!!
!-------------------------------------------------------------------------------
!
USE MODDB_INTBUDGET,ONLY:TAB_VARMULT,TVARSM,CVARNAME,NLON
USE DDH_MIX, ONLY:NFLEVGDDH,NPROMADDH,ADD_FIELD_3D, &
& TYP_DDH, NEW_ADD_FIELD_3D ! reference is Arpege
USE OML_MOD, ONLY : OML_MY_THREAD
USE YOMLDDH, ONLY : TLDDH
USE YOMMDDH, ONLY : TMDDH
IMPLICIT NONE
!
!
!* 0.1 Declarations of arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! source of the variable
INTEGER , INTENT(IN) :: KBUDN ! variable number
CHARACTER (LEN=*) , INTENT(IN) :: HBUVAR ! Identifier of the Budget
TYPE(TYP_DDH) , INTENT(INOUT) :: YDDDH
TYPE(TLDDH) , INTENT(IN) :: YDLDDH
TYPE(TMDDH) , INTENT(IN) :: YDMDDH
LOGICAL, OPTIONAL , INTENT(IN) :: LDISDIFF ! PVARS contains the increment (default is .FALSE.)
!* 0.2 Declaration of local variables:
REAL,DIMENSION(NPROMADDH,NFLEVGDDH):: ZVARS
LOGICAL :: LINST,LDDH
INTEGER::IINCR,JLON,JLEV,IFDIA,IOFF
CHARACTER (LEN=4) :: CLPROC
CHARACTER (LEN=11) :: CLDDH
LOGICAL :: LISDIFF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',0,ZHOOK_HANDLE)
IF (PRESENT(LDISDIFF)) THEN
LISDIFF=LDISDIFF
ELSE
LISDIFF=.FALSE.
ENDIF
IFDIA=SIZE(PVARS,1)
ZVARS(:,:)=0.
IF (SIZE(PVARS,3)==NFLEVGDDH+2) THEN
IOFF=1
ELSE
IOFF=0
ENDIF
!if length is less than 4, fill with budget old names
IF(LEN(HBUVAR)==1) THEN
CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_BU'
ELSE IF(LEN(HBUVAR)==2) THEN
CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_B'
ELSE IF(LEN(HBUVAR)==3) THEN
CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_'
ELSE
CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))
END IF
!
IF (YDLDDH%LDDH_OMP) THEN
CLDDH='T'//YDDDH%YVARMULT(KBUDN)%CNAME//CLPROC
ELSE
CLDDH='T'//CVARNAME(KBUDN)//CLPROC
ENDIF
! depi not stored through call to budget but add_field
IF ((CLPROC=='DEPI').OR.(CLPROC=='CEDS')) THEN
IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',1,ZHOOK_HANDLE)
RETURN
ENDIF
!1. Substraction of value at previous process and updates PVARSM
IF (YDLDDH%LDDH_OMP) THEN
IF (CLPROC=='INIF') THEN
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ELSE
IF (LISDIFF) THEN
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=YDDDH%RVARSM(JLON,1,JLEV,KBUDN)+PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ELSE
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)-YDDDH%RVARSM(JLON,1,JLEV,KBUDN)
YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ENDIF
ENDIF
ELSE
IF (CLPROC=='INIF') THEN
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
TVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ELSE
IF (LISDIFF) THEN
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
TVARSM(JLON,1,JLEV,KBUDN)=TVARSM(JLON,1,JLEV,KBUDN)+PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ELSE
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)-TVARSM(JLON,1,JLEV,KBUDN)
TVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ENDIF
ENDIF
ENDIF
!2. Reverse levels MNH-> ALD
!IINCR=-1
!CALL INVERT_VLEV(1,NLON,NFLEVGDDH,IINCR,ZVARS,PVARS2)
!3. CONVERSION
! converting to desired budget variables
IF (YDLDDH%LDDH_OMP) THEN
ZVARS(:,:)=ZVARS(:,:)*YDDDH%YVARMULT(KBUDN)%RVAL(:,:)
ELSE
ZVARS(:,:)=ZVARS(:,:)*TAB_VARMULT(KBUDN)%VARMULT(:,:)
ENDIF
!4. CALL TO ADD_FIELD
LDDH=.TRUE.
LINST=.TRUE.
! saves ZVARS with NAME HBUVAR as a Tendency from AROME
! and it is an INSTantaneous field
IF (CLPROC/='INIF') THEN
IF (YDLDDH%LDDH_OMP) THEN
CALL NEW_ADD_FIELD_3D(YDMDDH,ZVARS,CLDDH,YDDDH)
ELSE
CALL ADD_FIELD_3D(YDLDDH,ZVARS,CLDDH,'T','AROME',LINST,LDDH)
ENDIF
ENDIF
IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',1,ZHOOK_HANDLE)
END SUBROUTINE BUDGET_DDH
This diff is collapsed.
This diff is collapsed.
! ######spl
MODULE MODD_DYN
! ################
!
!!**** *MODD_DYN* - declaration of dynamic control variables
!!
!! PURPOSE
!! -------
! The purpose of this declarative module is to declare the dynamic
! control variables for all models.
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_PARAMETERS : contains the maximum number of coupling files
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (module MODD_DYN)
!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
!!
!! AUTHOR
!! ------
!! V. Ducrocq *Meteo France*
!!
!! MODIFICATIONS
!! -------------
!! Original 06/05/94
!! Modifications 17/10/94 (Stein) For LCORIO
!! Modifications 12/12/94 (Stein) remove LABSLAYER + add XALZBOT
!! and XALKBOT
!! Modifications 10/03/95 (I.Mallet) add coupling variables
!! 04/05/07 (C.Lac) Separation of num.diffusion
!! between variables
!---------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_PARAMETERS
!
IMPLICIT NONE
!
REAL ,SAVE :: XSEGLEN ! Duration of segment (in seconds)
REAL ,SAVE :: XASSELIN ! Asselin coefficient
REAL ,SAVE :: XASSELIN_SV! Asselin coefficient for tracer variables
LOGICAL,SAVE :: LCORIO ! Coriolis flag
LOGICAL,SAVE :: LNUMDIFU ! logical switch for the NUMerical DIFFusion:
! .TRUE. active .FALSE. unactive
! for momentum
LOGICAL,SAVE :: LNUMDIFTH ! For theta and mixing ratio
LOGICAL,SAVE :: LNUMDIFSV ! For scalar variables
LOGICAL,SAVE :: LSTEADYLS ! logical switch to remove all Larger Scale fields
! evolution during the segment (the LS fields are
! STEADY).TRUE. LS steady .FALSE. LS unsteady
REAL ,SAVE :: XALKTOP ! Damping coef. at the top of the absorbing
! layer
REAL ,SAVE :: XALZBOT ! Height of the absorbing layer base
!
INTEGER,SAVE :: NCPL_NBR ! NumBeR of CouPLing files
INTEGER,SAVE :: NCPL_CUR ! Number of CURrent CouPLing file
!
LOGICAL, SAVE, DIMENSION(JPMODELMAX) :: LUSERV_G, LUSERC_G, LUSERR_G, LUSERI_G
LOGICAL, SAVE, DIMENSION(JPMODELMAX) :: LUSERS_G, LUSERH_G, LUSERG_G
LOGICAL, SAVE, DIMENSION(JPMODELMAX) :: LUSETKE
LOGICAL, SAVE, DIMENSION(JPSVMAX,JPMODELMAX) :: LUSESV
REAL, SAVE, DIMENSION(JPCPLFILEMAX,JPMODELMAX) :: NCPL_TIMES ! array of
! the number for the coupling instants of every nested model
REAL, SAVE :: XTSTEP_MODEL1 ! time step of the
! outermost model
END MODULE MODD_DYN
MODULE MODE_BUDGET MODULE MODE_BUDGET
USE MODD_BUDGET, ONLY : TBUDGETDATA USE MODD_BUDGET, ONLY : TBUDGETDATA
USE MODI_BUDGET_DDH, ONLY: BUDGET_DDH
IMPLICIT NONE IMPLICIT NONE
CONTAINS CONTAINS
...@@ -49,4 +48,221 @@ USE MODDB_INTBUDGET, ONLY:TVARSM ...@@ -49,4 +48,221 @@ USE MODDB_INTBUDGET, ONLY:TVARSM
&LDISDIFF=.TRUE.) &LDISDIFF=.TRUE.)
#endif #endif
END SUBROUTINE BUDGET_STORE_ADD END SUBROUTINE BUDGET_STORE_ADD
SUBROUTINE BUDGET_DDH(PVARS,KBUDN,HBUVAR,YDDDH, YDLDDH, YDMDDH, LDISDIFF)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #####################################
!
!! BUDGET - routine to call the BUDGET routine for AROME.
!!
!! BEWARE THIS ROUTINE iS DIFFERENT FROM THE MNH ROUTINE BUDGET
!! EVEN IF IT WEARS THE SAME NAME !!!
!!
!! PURPOSE
!! -------
! This routine is an interface for the add_ddh subroutine.
! It converts the selected field into klev reversed vertical
! levels and attributes to the selected field are created.
!
!!** METHOD
!! ------
!!
!! 1st step: substract previous step (sequential approach in MNH)
!! 2nd step: reverse levels
!! 3rd step: multiplication by conversion factor for r-> q
!! or Theta-> T
!!
!! 4rd step: call to add_ddh now that the field has an Aladin shape
!!
!!
!! EXTERNAL
!! --------
!! ADD_FIELD_3D
!! INVERT_VLEV
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_INTBUDGET:
!!
!! PVARS_M(nlon,1,nlev,13) !13 different budgets
!! VARMULT(:,:,13) ! allows to convert variables
!!
!! REFERENCE
!! ---------
!! "New data flow for diagnostics in Arome/Arpege"
!!
!! AUTHOR
!! ------
!! O.Riviere 17/07/08 * Meteo France *
!!
!!
!! MODIFICATIONS
!! -------------
!! F.Voitus 16/05/17 : Introduction of new DDH superstructure for budget
!! S.Riette Jan 2022 : LDISDIFF case
!!
!-------------------------------------------------------------------------------
!
USE MODDB_INTBUDGET,ONLY:TAB_VARMULT,TVARSM,CVARNAME,NLON
USE DDH_MIX, ONLY:NFLEVGDDH,NPROMADDH,ADD_FIELD_3D, &
& TYP_DDH, NEW_ADD_FIELD_3D ! reference is Arpege
USE OML_MOD, ONLY : OML_MY_THREAD
USE YOMLDDH, ONLY : TLDDH
USE YOMMDDH, ONLY : TMDDH
IMPLICIT NONE
!
!
!* 0.1 Declarations of arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! source of the variable
INTEGER , INTENT(IN) :: KBUDN ! variable number
CHARACTER (LEN=*) , INTENT(IN) :: HBUVAR ! Identifier of the Budget
TYPE(TYP_DDH) , INTENT(INOUT) :: YDDDH
TYPE(TLDDH) , INTENT(IN) :: YDLDDH
TYPE(TMDDH) , INTENT(IN) :: YDMDDH
LOGICAL, OPTIONAL , INTENT(IN) :: LDISDIFF ! PVARS contains the increment (default is .FALSE.)
!* 0.2 Declaration of local variables:
REAL,DIMENSION(NPROMADDH,NFLEVGDDH):: ZVARS
LOGICAL :: LINST,LDDH
INTEGER::IINCR,JLON,JLEV,IFDIA,IOFF
CHARACTER (LEN=4) :: CLPROC
CHARACTER (LEN=11) :: CLDDH
LOGICAL :: LISDIFF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',0,ZHOOK_HANDLE)
IF (PRESENT(LDISDIFF)) THEN
LISDIFF=LDISDIFF
ELSE
LISDIFF=.FALSE.
ENDIF
IFDIA=SIZE(PVARS,1)
ZVARS(:,:)=0.
IF (SIZE(PVARS,3)==NFLEVGDDH+2) THEN
IOFF=1
ELSE
IOFF=0
ENDIF
!if length is less than 4, fill with budget old names
IF(LEN(HBUVAR)==1) THEN
CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_BU'
ELSE IF(LEN(HBUVAR)==2) THEN
CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_B'
ELSE IF(LEN(HBUVAR)==3) THEN
CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_'
ELSE
CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))
END IF
!
IF (YDLDDH%LDDH_OMP) THEN
CLDDH='T'//YDDDH%YVARMULT(KBUDN)%CNAME//CLPROC
ELSE
CLDDH='T'//CVARNAME(KBUDN)//CLPROC
ENDIF
! depi not stored through call to budget but add_field
IF ((CLPROC=='DEPI').OR.(CLPROC=='CEDS')) THEN
IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',1,ZHOOK_HANDLE)
RETURN
ENDIF
!1. Substraction of value at previous process and updates PVARSM
IF (YDLDDH%LDDH_OMP) THEN
IF (CLPROC=='INIF') THEN
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ELSE
IF (LISDIFF) THEN
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=YDDDH%RVARSM(JLON,1,JLEV,KBUDN)+PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ELSE
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)-YDDDH%RVARSM(JLON,1,JLEV,KBUDN)
YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ENDIF
ENDIF
ELSE
IF (CLPROC=='INIF') THEN
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
TVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ELSE
IF (LISDIFF) THEN
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
TVARSM(JLON,1,JLEV,KBUDN)=TVARSM(JLON,1,JLEV,KBUDN)+PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ELSE
DO JLEV=1,NFLEVGDDH
DO JLON=1,IFDIA
ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)-TVARSM(JLON,1,JLEV,KBUDN)
TVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
ENDDO
ENDDO
ENDIF
ENDIF
ENDIF
!2. Reverse levels MNH-> ALD
!IINCR=-1
!CALL INVERT_VLEV(1,NLON,NFLEVGDDH,IINCR,ZVARS,PVARS2)
!3. CONVERSION
! converting to desired budget variables
IF (YDLDDH%LDDH_OMP) THEN
ZVARS(:,:)=ZVARS(:,:)*YDDDH%YVARMULT(KBUDN)%RVAL(:,:)
ELSE
ZVARS(:,:)=ZVARS(:,:)*TAB_VARMULT(KBUDN)%VARMULT(:,:)
ENDIF
!4. CALL TO ADD_FIELD
LDDH=.TRUE.
LINST=.TRUE.
! saves ZVARS with NAME HBUVAR as a Tendency from AROME
! and it is an INSTantaneous field
IF (CLPROC/='INIF') THEN
IF (YDLDDH%LDDH_OMP) THEN
CALL NEW_ADD_FIELD_3D(YDMDDH,ZVARS,CLDDH,YDDDH)
ELSE
CALL ADD_FIELD_3D(YDLDDH,ZVARS,CLDDH,'T','AROME',LINST,LDDH)
ENDIF
ENDIF
IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',1,ZHOOK_HANDLE)
END SUBROUTINE BUDGET_DDH
END MODULE MODE_BUDGET END MODULE MODE_BUDGET
! ######spl
MODULE MODI_BUDGET_DDH
!##################
!
INTERFACE
!
SUBROUTINE BUDGET_DDH(PVARS,KBUDN,HBUVAR,YDDDH, YDLDDH, YDMDDH, LDISDIFF)
!
USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
USE YOMMDDH, ONLY : TMDDH
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
INTEGER , INTENT(IN) :: KBUDN ! variable number
CHARACTER (LEN=*) , INTENT(IN) :: HBUVAR ! Identifier of the Budget of the
! variable that is considered
TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
TYPE(TLDDH), INTENT(IN) :: YDLDDH
TYPE(TMDDH), INTENT(IN) :: YDMDDH
LOGICAL, OPTIONAL, INTENT(IN) :: LDISDIFF ! PVARS contains the increment
!
END SUBROUTINE BUDGET_DDH
!
END INTERFACE
!
END MODULE MODI_BUDGET_DDH
! ######spl
MODULE MODI_INI_BUDGET
! ######################
INTERFACE
SUBROUTINE INI_BUDGET(KLUOUT, HLUOUT,PTSTEP,KSV,KRR, &
ONUMDIFU,ONUMDIFTH,ONUMDIFSV, &
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
OHORELAX_SV,OVE_RELAX,OCHTRANS,ONUDGING,ODRAGTREE, &
HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD, &
HMET_ADV_SCHEME,HSV_ADV_SCHEME)
!
INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name of output listing
REAL, INTENT(IN) :: PTSTEP ! time step
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
INTEGER, INTENT(IN) :: KRR ! number of moist variables
LOGICAL, INTENT(IN) :: ONUMDIFU ! switch to activate the numerical
! diffusion for momentum
LOGICAL, INTENT(IN) :: ONUMDIFTH ! for meteorological scalar variables
LOGICAL, INTENT(IN) :: ONUMDIFSV ! for tracer scalar variables
LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the
! horizontal relaxation for U,V,W,TH
LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the
! horizontal relaxation for Rv
LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the
! horizontal relaxation for Rc
LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the
! horizontal relaxation for Rr
LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the
! horizontal relaxation for Ri
LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the
! horizontal relaxation for Rs
LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the
! horizontal relaxation for Rg
LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the
! horizontal relaxation for Rh
LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
! horizontal relaxation for tke
LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
! horizontal relaxation for scalar variables
LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical
! relaxation
LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
!transport for SV
LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the deep convection scheme
CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme
CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
! scheme
CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
CHARACTER (LEN=*), INTENT(IN) :: HMET_ADV_SCHEME ! type of advection scheme
! for meteorological scalar variables
CHARACTER (LEN=*), INTENT(IN) :: HSV_ADV_SCHEME ! type of advection scheme
! for tracer scalar variables
!
END SUBROUTINE INI_BUDGET
!
END INTERFACE
!
END MODULE MODI_INI_BUDGET
This diff is collapsed.
SUBROUTINE ARO_MNHDUST(KKL,KLON,KLEV,KSV,PTSTEP &
,PSVTIN & !I [moments/molec_{air}] Transported moments of dust
,PZZ & !I [m] height of layers
,PDZZ & !I [m] height of layers
,PPABST & !I Pressure
,PTHT & !I Potential temperature
,PRHODREF & !I [kg/m3] density of air
,KSWB & !I [nbr] number of shortwave bands
,KTCOUNT & !I number of time step
,PSVT & !O [moments/molec_{air}] Transported moments of dust
,PPIZA_WVL & !IO [-] single scattering albedo of dust layer for all SW wavelength
,PCGA_WVL & !IO [-] assymetry factor for dust layer for all SW wavelength
,PTAUREL_WVL & !IO [-] opt.depth/opt.depth(550) for dust layer for all SWwvl
,PAER & !IO [-] ext coeff at 550 for dust layer
,NDIAG & !I [-] nb of diagnostics
,PPEZDIAG & !IO [-] diag Nb/m3,ug/m3,rg(nb;um),rg(m;um),SSA,assym,AOD/550,mode & wvl
)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!*** *ARO_MNHDUST*
!
! PURPOSE
! -------
! Interface routine for initialisation of dust optical properties
! before radiation scheme call
! AUTHOR.
! -------
! Y. Seity (CNRM/GMAP)
! 10-10-05
! MODIFICATIONS
! -------------
! P. Tulet 10/02/06
! P. Tulet add scavenging 10/02/08
! M. Mokhtari & A. Ambar 09/2016: inversion levels, call inv_levels.F90
!
! EXTERNAL
! -------
USE MODE_DUSTOPT, ONLY: DUSTOPT_GET
USE MODE_DUST_PSD ! include PPP2DUST
USE MODI_INIT_DUST
USE MODI_SEDIM_DUST
USE MODD_DUST ! LDUST=.FALSE. ; NMODE_DST=3
USE MODD_NSV, ONLY : NSV_DSTBEG, NSV_DSTEND
USE MODI_INV_LEVELS
IMPLICIT NONE
!INPUT
INTEGER, INTENT(IN) :: KKL ! vertical levels ordering 1: MNH -1: ARPEGE
INTEGER, INTENT(IN) :: KLON ! NPROMA under CPG
INTEGER, INTENT(IN) :: KLEV ! Number of vertical levels
INTEGER, INTENT(IN) :: KSV ! Number of passive scalar
INTEGER, INTENT(IN) :: KSWB ! Number of shortwave wavelengths
INTEGER, INTENT(IN) :: KTCOUNT ! Number of time step
REAL, INTENT(IN) :: PTSTEP ! Time step in s
REAL, DIMENSION(KLON,1,KLEV,KSV),INTENT(IN) :: PSVTIN !I [moments/molec_{air}] transported moments of dust
INTEGER, INTENT(IN) :: NDIAG ! nb of diagnostics
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PZZ !I [m] height of layers
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PDZZ !I [m] layers thikness
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PRHODREF !I [kg/m3] density of air
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PTHT !I [K] potentiel temperature
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PPABST !I [Pa] pressure
!OUTPUT
REAL, DIMENSION(KLON,1,KLEV,KSV),INTENT(OUT) :: PSVT !O [moments/molec_{air}] transported moments of dust
REAL, DIMENSION(KLON,KLEV,KSWB),INTENT(INOUT) :: PPIZA_WVL !O [-] SSA of dust layer for all SW wvl
REAL, DIMENSION(KLON,KLEV,KSWB),INTENT(INOUT) :: PCGA_WVL !O [-] assym factor for dust layer for all SW
REAL, DIMENSION(KLON,KLEV,KSWB),INTENT(INOUT) :: PTAUREL_WVL !O [-] AOD/AOD(550) for dust layer for all SW
REAL, DIMENSION(KLON,KLEV,NDIAG),INTENT(INOUT) :: PPEZDIAG !O [-] Diagnostics table
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PAER !O [-] AOD/AOD(550) for dust layer for all SW wvl
!
!* 0.2 Declarations of local variables :
INTEGER :: JLEV,JK,JK1,IMOD,INSWB,WVL_IDX
INTEGER :: IKE, JSV, JL
REAL :: ZSIGMIN
REAL, DIMENSION(KLON,1,KLEV+2,KSWB) :: ZPIZA_DST_TMP, ZCGA_DST_TMP, ZTAUREL_DST_TMP, &
& ZPIZAZ, ZCGAZ, ZTAUAZ
REAL, DIMENSION(KLON,1,KLEV+2,NMODE_DST) :: ZSIGDST, ZRGDST, ZNDST, &
& ZRGMDST, ZMDST
REAL, DIMENSION(KLON,1,KLEV+2) :: ZAER
REAL, DIMENSION(KLON,KLEV,KSWB) :: ZPIZAZ_WVL
REAL, DIMENSION(KLON,KLEV,KSWB) :: ZCGAZ_WVL
REAL, DIMENSION(KLON,KLEV,KSWB) :: ZTAUAZ_WVL
REAL, DIMENSION(KLON,KLEV,NMODE_DST) :: ZRGDST_MOD
REAL, DIMENSION(KLON,KLEV,NMODE_DST) :: ZRGMDST_MOD
REAL, DIMENSION(KLON,KLEV,NMODE_DST) :: ZNDST_MOD
REAL, DIMENSION(KLON,KLEV,NMODE_DST) :: ZMDST_MOD
!
REAL,DIMENSION(KLON,1,KLEV+2) :: ZZZ ! Local value of PZZ
REAL,DIMENSION(KLON,1,KLEV+2) :: ZDZZ ! Local value of PDZZ
REAL,DIMENSION(KLON,1,KLEV+2) :: ZPABST ! Local value of ZPABST
REAL,DIMENSION(KLON,1,KLEV+2) :: ZTHT ! Local value of ZTHT
REAL,DIMENSION(KLON,1,KLEV+2) :: ZRHODREF ! Local value of ZRHODREF
REAL,DIMENSION(KLON,1,KLEV+2,KSV) :: ZSVT ! Local value of ZSVT
!
REAL,DIMENSION(KLON,1,KLEV) :: ZZPABST ! Local value of ZPABST
REAL,DIMENSION(KLON,1,KLEV) :: ZZTHT ! Local value of ZTHT
REAL,DIMENSION(KLON,1,KLEV) :: ZZRHODREF ! Local value of ZRHODREF
REAL,DIMENSION(KLON,1,KLEV,KSV) :: ZZSVT ! Local value of ZSVT
!--------------------------------------------------------------------
! 1) Initialization of dust
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ARO_MNHDUST',0,ZHOOK_HANDLE)
!
!* 1. PRELIMINARY COMPUTATIONS
!initialisation de ZZZ
DO JL = 1,KLON
DO JK = 2 , KLEV+1
ZZZ(JL,1,JK)=PZZ(JL,1,KLEV+2-JK)
ENDDO
ZZZ(JL,1,1) = 2*ZZZ(JL,1,2)-ZZZ(JL,1,3)
ZZZ(JL,1,KLEV+2) = 2*ZZZ(JL,1,KLEV+1)-ZZZ(JL,1,KLEV)
ENDDO
!initialisation de ZDZZ
DO JL = 1,KLON
DO JK = 1 , KLEV+1
ZDZZ(JL,1,JK)=ZZZ(JL,1,JK+1)-ZZZ(JL,1,JK)
ENDDO
ZDZZ(JL,1,KLEV+2)=ZZZ(JL,1,KLEV+2)-ZZZ(JL,1,KLEV+1)
ENDDO
!
ZZRHODREF(:,:,:) = PRHODREF(:,:,:)
ZZPABST(:,:,:) = PPABST(:,:,:)
ZZTHT(:,:,:) = PTHT(:,:,:)
ZZSVT(:,:,:,:) = PSVTIN(:,:,:,:)
!
CALL INV_LEVELS(1,KLON,KLEV,1,ZZRHODREF,ZRHODREF)
CALL INV_LEVELS(1,KLON,KLEV,1,ZZPABST,ZPABST)
CALL INV_LEVELS(1,KLON,KLEV,1,ZZTHT,ZTHT)
!initialisation de ZSVT
DO JSV=1,KSV
CALL INV_LEVELS(1,KLON,KLEV,1,ZZSVT(:,:,:,JSV),ZSVT(:,:,:,JSV))
ENDDO
!
IF ((KTCOUNT == 1).AND.(LDSTINIT)) THEN
CALL INIT_DUST(ZSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZRHODREF)
END IF
!Get dust optical properties from look up tables
CALL DUSTOPT_GET( &
ZSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND) & !I [ppp] Dust scalar concentration
,ZZZ(:,:,:) & !I [m] height of layers
,ZRHODREF(:,:,:) & !I [kg/m3] density of air
,ZPIZA_DST_TMP & !O [-] single scattering albedo of dust
,ZCGA_DST_TMP & !O [-] assymetry factor for dust
,ZTAUREL_DST_TMP & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
,ZAER(:,:,:) & !O [-] optical depth of dust at wvl=550nm
,KSWB & !I |nbr] number of shortwave bands
)
! Compute SSA, AOD, assymetry factor for clear sky (dust aerosols)
ZTAUAZ(:,:,:,:)=0.
ZPIZAZ(:,:,:,:)=0.
ZCGAZ(:,:,:,:)=0.
DO WVL_IDX=1,KSWB
! Ponderation of aerosol optical depht in case of explicit factor
! ti
ZTAUAZ(:,:,:,WVL_IDX) = ZTAUAZ(:,:,:,WVL_IDX) + &
ZAER(:,:,:) * &
ZTAUREL_DST_TMP(:,:,:,WVL_IDX)
! wi*ti
ZPIZAZ(:,:,:,WVL_IDX) = ZPIZAZ(:,:,:,WVL_IDX) + &
ZAER(:,:,:) * &
ZTAUREL_DST_TMP(:,:,:,WVL_IDX) * &
ZPIZA_DST_TMP(:,:,:,WVL_IDX)
! gi*wi*ti
ZCGAZ(:,:,:,WVL_IDX) = ZCGAZ(:,:,:,WVL_IDX) + &
ZAER(:,:,:) * &
ZTAUREL_DST_TMP(:,:,:,WVL_IDX) * &
ZPIZA_DST_TMP(:,:,:,WVL_IDX) * &
ZCGA_DST_TMP(:,:,:,WVL_IDX)
ENDDO
! Ponderation of assymetry factor
ZCGAZ(:,:,:,:) = ZCGAZ(:,:,:,:) / ZPIZAZ(:,:,:,:)
! Ponderation of SSA
ZPIZAZ(:,:,:,:) = ZPIZAZ(:,:,:,:) / ZTAUAZ(:,:,:,:)
! Compute and store Standard deviation, median radius, concentration of dust from moments
CALL PPP2DUST (ZSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), &
ZRHODREF(:,:,:), &
ZSIGDST(:,:,:,:), &
ZRGDST(:,:,:,:), &
ZNDST(:,:,:,:))
ZRGMDST(:,:,:,:)=0.
ZMDST(:,:,:,:)=0.
! Compute mass median radius in um in all dust mode
ZRGMDST(:,:,:,:) = ZRGDST(:,:,:,:) / (exp(-3.*(log(ZSIGDST(:,:,:,:)))**2))
! Compute integrated mass concentration ug/m3 in all dust mode
ZMDST(:,:,:,:) = ZNDST(:,:,:,:)*4./3.*3.14*2500.*1e9 *& !kg-->ug
(ZRGDST(:,:,:,:)**3)*1.d-18 *& !um-->m
exp(4.5*log(ZSIGDST(:,:,:,:))*log(ZSIGDST(:,:,:,:)))
!Transform from vector of type #lon #lat #lev #wvl or #mod
!to vectors of type #points, #inverted levs, #wavelengths or #modes
JLEV = KLEV
ZTAUAZ_WVL(:,:,:)= 0.
ZPIZAZ_WVL(:,:,:)= 0.
ZCGAZ_WVL(:,:,:) = 0.
ZRGDST_MOD(:,:,:)= 0.
ZRGMDST_MOD(:,:,:)=0.
ZNDST_MOD(:,:,:) = 0.
ZMDST_MOD(:,:,:) = 0.
DO JK=1,JLEV
JK1=JLEV+2-JK
PPIZA_WVL(:,JK,:) = ZPIZA_DST_TMP(:,1,JK1,:)
PCGA_WVL(:,JK,:) = ZCGA_DST_TMP(:,1,JK1,:)
PTAUREL_WVL(:,JK,:) = ZTAUREL_DST_TMP(:,1,JK1,:)
PAER(:,JK) = ZAER(:,1,JK1)
ZPIZAZ_WVL(:,JK,:) = ZPIZAZ(:,1,JK1,:)
ZCGAZ_WVL(:,JK,:) = ZCGAZ(:,1,JK1,:)
ZTAUAZ_WVL(:,JK,:) = ZTAUAZ(:,1,JK1,:)
ZRGDST_MOD(:,JK,:) = ZRGDST(:,1,JK1,:)
ZRGMDST_MOD(:,JK,:) = ZRGMDST(:,1,JK1,:)
ZNDST_MOD(:,JK,:) = ZNDST(:,1,JK1,:)
ZMDST_MOD(:,JK,:) = ZMDST(:,1,JK1,:)
ENDDO
! somme on every mode (different dust diameter)
IF (SIZE(PPEZDIAG, 3) .GE. 4) THEN
PPEZDIAG(:,:,1:4) = 0.
DO IMOD = 1,NMODE_DST ! NMODE_DST!=3 ! PPEZDIAG<25
PPEZDIAG(:,:,1) = PPEZDIAG(:,:,1) + ZNDST_MOD(:,:,IMOD) ! Nb/m3
PPEZDIAG(:,:,2) = PPEZDIAG(:,:,2) + ZMDST_MOD(:,:,IMOD) ! Mass(ug)/m3
PPEZDIAG(:,:,3) = PPEZDIAG(:,:,3) + ZRGDST_MOD(:,:,IMOD) ! RG nb (um)
PPEZDIAG(:,:,4) = PPEZDIAG(:,:,4) + ZRGMDST_MOD(:,:,IMOD) ! RG m (um)
ENDDO
END IF
IF (SIZE(PPEZDIAG, 3) .GE. 7) THEN
! somme on every level (integreted value)
PPEZDIAG(:,:,5:7) = 0.
DO JK=1,JLEV
! to have lwv=550nm : NSWB = 3 !NSWB!=6 ! PPEZDIAG<25
PPEZDIAG(:,1,5) = PPEZDIAG(:,1,5) + ZPIZAZ_WVL(:,JK,3) ! SSA(550)
PPEZDIAG(:,1,6) = PPEZDIAG(:,1,6) + ZCGAZ_WVL(:,JK,3) ! assymetry(550)
PPEZDIAG(:,1,7) = PPEZDIAG(:,1,7) + ZTAUAZ_WVL(:,JK,3) ! AOD/AOD(550)
ENDDO
DO JK=1,JLEV
PPEZDIAG(:,JK,5) = PPEZDIAG(:,1,5)
PPEZDIAG(:,JK,6) = PPEZDIAG(:,1,6)
PPEZDIAG(:,JK,7) = PPEZDIAG(:,1,7)
ENDDO
END IF
IF (LSEDIMDUST) THEN
IKE = KLEV+2
CALL SEDIM_DUST(ZTHT(:,:,1:IKE), PTSTEP, &
ZRHODREF(:,:,1:IKE), &
ZPABST(:,:,1:IKE), &
ZDZZ(:,:,1:IKE), &
ZSVT(:,:,1:IKE,NSV_DSTBEG:NSV_DSTEND))
ENDIF
!return to aladin/arome ZSVT
DO JSV=1,KSV
CALL INV_LEVELS(1,KLON,KLEV,-1,PSVT(:,:,:,JSV),ZSVT(:,:,:,JSV))
ENDDO
!
IF (LHOOK) CALL DR_HOOK('ARO_MNHDUST',1,ZHOOK_HANDLE)
END SUBROUTINE ARO_MNHDUST
SUBROUTINE ARO_RAINAERO(KLON,KLEV,NSV,KRR,PTSTEP &
,PSVTIN & !I [moments/molec_{air}] Transported moments of dust
,PZZ & !I [m] height of layers
,PPABST & ! Pressure
,PTHT & ! Potential temperature
,PRHODREF & !I [kg/m3] density of air
,KTCOUNT & ! number of time step
,PRT & ! moist field
,PEVAP & ! evaporation profile
,KSPLITR & ! rain sedimentation time splitting
,PSVT & !O [moments/molec_{air}] Transported moments of dust
)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
!*** *ARO_RAINAERO*
!
! PURPOSE
! -------
! Interface routine for aerosol scavenging
! AUTHOR.
! -------
! P. Tulet
! 10-03-08
! MODIFICATIONS
! -------------
! M. Mokhtari & A. Ambar 09/2016: inversion levels, call inv_levels.F90
!
! EXTERNAL
! -------
USE MODI_AER_WET_DEP_KMT_WARM
USE MODD_DUST
USE MODD_CSTS_DUST
USE MODD_CST
USE MODD_NSV, ONLY : NSV_DSTBEG, NSV_DSTEND, &
NSV_DSTDEPBEG, NSV_DSTDEPEND
USE MODE_DUST_PSD
USE MODI_INV_LEVELS
IMPLICIT NONE
!INPUT
INTEGER, INTENT(IN) :: KLON ! NPROMA under CPG
INTEGER, INTENT(IN) :: KLEV ! Number of vertical levels
INTEGER, INTENT(IN) :: NSV ! Number of passive scalar
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
REAL, INTENT(IN) :: PTSTEP ! Time step
REAL, DIMENSION(KLON,1,KLEV,NSV),INTENT(IN) :: PSVTIN
REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(IN) :: PRT ! Moist variables at time t
!I [moments/molec_{air}] transported moments of dust
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PZZ !I [m] height of layers
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PRHODREF !I [kg/m3] density of air
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PTHT !I [K] potentiel temperature
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PPABST !I [Pa] pressure
REAL, DIMENSION(KLON,1,KLEV),INTENT(IN) :: PEVAP !I Evaporation
INTEGER, INTENT(IN) :: KTCOUNT ! Number of time step
INTEGER, INTENT(IN) :: KSPLITR ! Rain sedimentation time spliting
REAL, DIMENSION(KLON,1,KLEV,NSV),INTENT(OUT) :: PSVT
INTEGER :: JLEV, JL, JK,JK1, IMODEIDX
INTEGER :: II, IKE, JSV, JRR
REAL :: ZSIGMIN
! local variable
REAL, DIMENSION(:), ALLOCATABLE :: ZMASSMIN, ZINIRADIUS
REAL,DIMENSION(KLON,1,KLEV+2) :: ZZZ ! Local value of PZZ
REAL,DIMENSION(KLON,1,KLEV+2) :: ZPABST ! Local value of ZPABST
REAL,DIMENSION(KLON,1,KLEV+2) :: ZTHT ! Local value of ZTHT
REAL,DIMENSION(KLON,1,KLEV+2) :: ZRHODREF ! Local value of ZRHODREF
REAL,DIMENSION(KLON,1,KLEV+2) :: ZEVAP ! Evaporation
REAL,DIMENSION(KLON,1,KLEV+2,KRR) :: ZRT ! Moist variables at time t
REAL,DIMENSION(KLON,1,KLEV+2,NSV) :: ZSVT ! Local value of ZSVT
!
REAL,DIMENSION(KLON,1,KLEV) :: ZZPABST ! Local value of ZPABST
REAL,DIMENSION(KLON,1,KLEV) :: ZZTHT ! Local value of ZTHT
REAL,DIMENSION(KLON,1,KLEV) :: ZZRHODREF ! Local value of ZRHODREF
REAL,DIMENSION(KLON,1,KLEV) :: ZZEVAP !I Evaporation
REAL,DIMENSION(KLON,1,KLEV,KRR) :: ZZRT ! Moist variables at time t
REAL,DIMENSION(KLON,1,KLEV,NSV) :: ZZSVT ! Local value of ZSVT
!
REAL, DIMENSION(KLON,1,KLEV+2,NMODE_DST) :: ZSIGDST, ZRGDST, ZNDST,ZVMASSMIN
REAL, DIMENSION(KLON,1,KLEV+2,NMODE_DST*3) :: ZSVDST
!--------------------------------------------------------------------
! 1) Initialization of aerosols acqueous variables
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ARO_RAINAERO',0,ZHOOK_HANDLE)
!
ALLOCATE(ZMASSMIN(NMODE_DST))
ALLOCATE(ZINIRADIUS(NMODE_DST))
!
!* 1. PRELIMINARY COMPUTATIONS
!* INVERS LEVEL FOR AROME
!initialisation de ZZZ
DO JL = 1,KLON
DO JK = 2 , KLEV+1
ZZZ(JL,1,JK)=PZZ(JL,1,KLEV+2-JK)
ENDDO
ZZZ(JL,1,1) = 2*ZZZ(JL,1,2)-ZZZ(JL,1,3)
ZZZ(JL,1,KLEV+2) = 2*ZZZ(JL,1,KLEV+1)-ZZZ(JL,1,KLEV)
ENDDO
!
ZZRHODREF(:,:,:) = PRHODREF(:,:,:)
ZZPABST(:,:,:) = PPABST(:,:,:)
ZZTHT(:,:,:) = PTHT(:,:,:)
ZZEVAP(:,:,:) = PEVAP(:,:,:)
ZZRT(:,:,:,:) = PRT(:,:,:,:)
ZZSVT(:,:,:,:) = PSVTIN(:,:,:,:)
ZSVDST(:,:,:,:) = 0.
!
CALL INV_LEVELS(1,KLON,KLEV,1,ZZRHODREF,ZRHODREF)
CALL INV_LEVELS(1,KLON,KLEV,1,ZZPABST,ZPABST)
CALL INV_LEVELS(1,KLON,KLEV,1,ZZTHT,ZTHT)
CALL INV_LEVELS(1,KLON,KLEV,1,ZZEVAP,ZEVAP)
!
DO JSV=1,NSV
CALL INV_LEVELS(1,KLON,KLEV,1,ZZSVT(:,:,:,JSV),ZSVT(:,:,:,JSV))
ENDDO
!
DO JRR=1,KRR
CALL INV_LEVELS(1,KLON,KLEV,1,ZZRT(:,:,:,JRR),ZRT(:,:,:,JRR))
ENDDO
!STEP 1
IF (KTCOUNT == 1) THEN
ZSVT(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND) = 0.
END IF
! 3.1 Minimum mass to transfer between dry mass or in-cloud droplets
DO JSV=1,NMODE_DST
IMODEIDX = JPDUSTORDER(JSV)
IF (CRGUNITD=="MASS") THEN
ZINIRADIUS(JSV) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2)
ELSE
ZINIRADIUS(JSV) = XINIRADIUS(IMODEIDX)
END IF
IF (LVARSIG) THEN
ZSIGMIN = XSIGMIN
ELSE
ZSIGMIN = XINISIG(IMODEIDX)
ENDIF
ZMASSMIN(JSV) = XN0MIN(IMODEIDX) * (ZINIRADIUS(JSV)**3)*EXP(4.5 * LOG(ZSIGMIN)**2)
! volume/um3 => #/molec_{air}
ZVMASSMIN(:,:,:,JSV)= ZMASSMIN(JSV) * XMD * XPI * 4./3. * XDENSITY_DUST / &
(XMOLARWEIGHT_DUST*XM3TOUM3*ZRHODREF(:,:,:))
ENDDO
!
! 3.3 Compute and store Standard deviation and mean radius
! from moments
CALL PPP2DUST(ZSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), &
ZRHODREF(:,:,:), &
ZSIGDST(:,:,:,:), &
ZRGDST(:,:,:,:), &
ZNDST(:,:,:,:))
! 3.4 Compute acquous aerosol mass vector from moment scalar vector
!
DO JSV= 1, NMODE_DST
IF (LVARSIG) THEN
ZSVDST(:,:,:,JSV) = ZSVT(:,:,:,NSV_DSTBEG+1+(JSV-1)*3)
ELSE IF (LRGFIX_DST) THEN
ZSVDST(:,:,:,JSV) = ZSVT(:,:,:,NSV_DSTBEG+JSV-1)
ELSE
ZSVDST(:,:,:,JSV) = ZSVT(:,:,:,NSV_DSTBEG+1+(JSV-1)*2)
ENDIF
ENDDO
DO JSV=1,2*NMODE_DST
ZSVDST(:,:,:,NMODE_DST+JSV) = ZSVT(:,:,:,NSV_DSTDEPBEG-1+JSV)
ENDDO
! One moment cloud scheme
CALL AER_WET_DEP_KMT_WARM (KSPLITR, &
PTSTEP, &
ZZZ(:,:,:), &
ZRHODREF(:,:,:), &
ZRT(:,:,:,2), &
ZRT(:,:,:,3), &
ZRT(:,:,:,2), &
ZRT(:,:,:,3), &
ZSVDST(:,:,:,:), &
ZTHT(:,:,:), &
ZPABST(:,:,:), &
ZRGDST(:,:,:,:), &
ZEVAP(:,:,:), &
NMODE_DST, &
XDENSITY_DUST, &
ZVMASSMIN )
! Compute return to moment vector
DO JSV=1,NMODE_DST
IF (LVARSIG) THEN
ZSVT(:,:,:,NSV_DSTBEG+1+(JSV-1)*3) = ZSVDST(:,:,:,JSV)
ELSE IF (LRGFIX_DST) THEN
ZSVT(:,:,:,NSV_DSTBEG+JSV-1) = ZSVDST(:,:,:,JSV)
ELSE
ZSVT(:,:,:,NSV_DSTBEG+1+(JSV-1)*2) = ZSVDST(:,:,:,JSV)
ENDIF
ENDDO
! Return to lognormal distribution (compute M0 and M6 using RG, SIG and
! new mass from M3)
CALL DUST2PPP(ZSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), &
ZRHODREF(:,:,:), &
ZSIGDST(:,:,:,:), &
ZRGDST(:,:,:,:))
DO JSV=1,2*NMODE_DST
ZSVT(:,:,:,NSV_DSTDEPBEG-1+JSV) = ZSVDST(:,:,:,NMODE_DST+JSV)
ENDDO
! Return to aladin/arome
DO JSV=1,NSV
CALL INV_LEVELS(1,KLON,KLEV,-1,PSVT(:,:,:,JSV),ZSVT(:,:,:,JSV))
ENDDO
!
DEALLOCATE(ZINIRADIUS)
DEALLOCATE(ZMASSMIN)
!
IF (LHOOK) CALL DR_HOOK('ARO_RAINAERO',1,ZHOOK_HANDLE)
END SUBROUTINE ARO_RAINAERO
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment