diff --git a/ext/aer_wet_dep_kmt_warm.f90 b/ext/aer_wet_dep_kmt_warm.f90
index cb2bb68e73e1fa5de72b8c7c206463ab5afc6fac..441484721eb49a50eede482f07cf7d23bb3c7dd1 100644
--- a/ext/aer_wet_dep_kmt_warm.f90
+++ b/ext/aer_wet_dep_kmt_warm.f90
@@ -12,7 +12,7 @@ INTERFACE
!!
SUBROUTINE AER_WET_DEP_KMT_WARM(KSPLITR, PTSTEP, PZZ, PRHODREF, &
PRCT, PRRT, &
- PRCS, PRRS, PSVT, PTHT, &
+ PSVT, PTHT, &
PPABST, PRGAER, PEVAP3D, KMODE, &
PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
PCCT, PCRT )
@@ -30,8 +30,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! Cloud water conc derived from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water conc derifed from source term
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Potential temp
@@ -53,7 +51,7 @@ END MODULE MODI_AER_WET_DEP_KMT_WARM
! ###############################################################
SUBROUTINE AER_WET_DEP_KMT_WARM (KSPLITR, PTSTEP, PZZ, &
PRHODREF, PRCT, PRRT, &
- PRCS, PRRS, PSVT, PTHT, &
+ PSVT, PTHT, &
PPABST, PRGAER, PEVAP3D, KMODE, &
PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
PCCT, PCRT )
@@ -123,14 +121,16 @@ END MODULE MODI_AER_WET_DEP_KMT_WARM
! ------------
!
USE MODD_CST
-USE MODD_RAIN_ICE_PARAM_n
+USE MODD_RAIN_ICE_PARAM_n, ONLY : YEXCACCR=>XEXCACCR, XFSEDC, XFCACCR,&
+ XEXSEDR, XCRIAUTC, XFSEDR, XTIMAUTC,&
+ YFCACCR => XFCACCR
!++th++ 10/05/17
USE MODD_RAIN_ICE_DESCR_n, ONLY : YRTMIN => XRTMIN, YCEXVT => XCEXVT, &
XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
XNUC2, XALPHAC2, XNUC, XALPHAC, &
YLBC => XLBC, XLBEXC, &
XCCR, &
- YLBR => XLBR, YLBEXR => XLBEXR
+ YLBR => XLBR, YLBEXR => XLBEXR
!--th--
USE MODD_PRECIP_n
USE MODI_AER_VELGRAV
@@ -145,7 +145,8 @@ USE MODD_PARAM_LIMA_WARM, ONLY : WLBR => XLBR, WLBEXR => XLBEXR, & ! fo
WLBC => XLBC, &
XACCR1, XACCR2, XACCR3, XACCR4, XACCR5, & ! for
XACCR_RLARGE1, XACCR_RLARGE2, & ! accr.
- XACCR_RSMALL1, XACCR_RSMALL2
+ XACCR_RSMALL1, XACCR_RSMALL2, &
+ WEXCACCR=>XEXCACCR, WFCACCR=>XFCACCR
USE MODD_PARAM_n, ONLY: CCLOUD
!--th--
@@ -165,8 +166,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! Cloud water m.r. from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. from source term
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temp
@@ -263,7 +262,7 @@ INTEGER :: IKE
REAL, DIMENSION(:), ALLOCATABLE :: KRTMIN
REAL :: KCEXVT, KLBR, KLBEXR, KLBC, ZLBEXC
REAL, DIMENSION(2) :: ZXLBC
-REAL :: ZEXSEDR, ZDR
+REAL :: ZEXSEDR, ZDR, ZEXCACCR, ZFCACCR
!
!-------------------------------------------------------------------------------
!
@@ -282,6 +281,8 @@ CASE('ICE3')
KLBEXR = YLBEXR
ZXLBC(:) = YLBC(:)
ZLBEXC = XLBEXC
+ ZEXCACCR = YEXCACCR
+ ZFCACCR = YFCACCR
CASE('LIMA')
ALLOCATE(KRTMIN(SIZE(WRTMIN)))
KRTMIN = WRTMIN
@@ -291,6 +292,8 @@ CASE('LIMA')
KLBC = WLBC
ZLBEXC = 1.0 / 3.0
ZDR = 0.8
+ ZEXCACCR = WEXCACCR
+ ZFCACCR = WFCACCR
END SELECT
!--cb--
!
@@ -361,9 +364,7 @@ CALL AER_WET_DEP_KMT_ICE_WARM
!
CALL AER_WET_DEP_KMT_EVAP
!
-!++cb++
DEALLOCATE(KRTMIN)
-!--cb--
!
!-------------------------------------------------------------------------------
!
@@ -396,12 +397,10 @@ INTEGER :: JKAQ ! counter for chemistry
GCLOUD(:,:,:) = .FALSE.
!
IF (PRESENT(PCCT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
- GCLOUD(:,:,:) = PRCS(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2)
+ GCLOUD(:,:,:) = PRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2)
ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
- GCLOUD(:,:,:) = PRCS(:,:,:) > KRTMIN(2)
+ GCLOUD(:,:,:) = PRCT(:,:,:) > KRTMIN(2)
END IF
-!--cb--
-!--th--
ICLOUD = COUNTJV( GCLOUD(:,:,:),I1C(:),I2C(:),I3C(:))
IF( ICLOUD >= 1 ) THEN
@@ -437,7 +436,7 @@ IF( ICLOUD >= 1 ) THEN
ZTHT(JL) = PTHT(I1C(JL),I2C(JL),I3C(JL))
ZRC(JL) = ZRAY(I1C(JL),I2C(JL),I3C(JL))
ZPABST(JL) = PPABST(I1C(JL),I2C(JL),I3C(JL))
- ZRCT(JL) = PRCS(I1C(JL),I2C(JL),I3C(JL))
+ ZRCT(JL) = PRCT(I1C(JL),I2C(JL),I3C(JL))
ZRHODREF(JL) = PRHODREF(I1C(JL),I2C(JL),I3C(JL))
ZMASSMIN(JL,:) = PMASSMIN(I1C(JL),I2C(JL),I3C(JL),:)
ZWLBDC(JL) = ZLBC(I1C(JL),I2C(JL),I3C(JL))
@@ -711,7 +710,7 @@ DO JN = 1 , KSPLITR
ZSVT(JL,KMODE*2+JKAQ) = PSVT(IR1(JL),IR2(JL),IR3(JL),KMODE*2+JKAQ)
END DO
!
- IF (PRESENT(PCRT)) ZCRT(JL) = PCRT(IR1(JL),IR2(JL),IR2(JL))
+ IF (PRESENT(PCRT)) ZCRT(JL) = PCRT(IR1(JL),IR2(JL),IR3(JL))
ZRRT(JL) = PRRT(IR1(JL),IR2(JL),IR3(JL))
ZRHODREF(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
ENDDO
@@ -803,10 +802,12 @@ ZZRCT(:,:,:) = MAX(ZZRCT(:,:,:), KRTMIN(2)/2.)
IF (PRESENT(PCRT)) THEN ! 2-moment schemes
!
! from lima_warm_coal.f90 (AUTO)
- ZLBDC3(:,:,:) = XMNH_HUGE
+ ZLBDC3(:,:,:) = 1E40
+ ! ZLBDC3(:,:,:) = XMNH_HUGE
ZLBDC(:,:,:) = 1.E15
WHERE (ZZRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2))
- ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / PRCT(:,:,:)
+ ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / ZZRCT(:,:,:)
+ ! ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / PRCT(:,:,:)
ZLBDC(:,:,:) = ZLBDC3(:,:,:)**ZLBEXC
END WHERE
!
@@ -814,14 +815,14 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
WHERE (ZZRCT(:,:,:) > KRTMIN(2))
ZZW3(:,:,:) = MAX(0.0, XLAUTR*PRHODREF(:,:,:)*ZZRCT(:,:,:)* &
(XAUTO1/ZLBDC3(:,:,:)**4-XLAUTR_THRESHOLD)) ! L
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), MAX(0.0, XITAUTR*ZZW3(:,:,:)*ZZRCT(:,:,:)* &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), MAX(0.0, XITAUTR*ZZW3(:,:,:)*ZZRCT(:,:,:)* &
(XAUTO2/ZLBDC3(:,:,:)-XITAUTR_THRESHOLD))) ! L/tau
END WHERE
!
ELSE ! 1-moment scheme
!
- WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRCS(:,:,:) > 0.0))
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XTIMAUTC* &
+ WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRCT(:,:,:) > 0.0))
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), XTIMAUTC* &
MAX((ZZRCT(:,:,:)-XCRIAUTC/PRHODREF(:,:,:)), 0.0))
END WHERE
!
@@ -853,12 +854,14 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
! from lima_warm_coal.f90 (ACCR)
ZLBDR3(:,:,:) = 1.E30
ZLBDR(:,:,:) = 1.E10
+
+
WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3))
ZLBDAR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
ZLBDR3(:,:,:) = KLBR * PCRT(:,:,:) / PRRT(:,:,:)
ZLBDR(:,:,:) = ZLBDR3(:,:,:)**KLBEXR
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XFCACCR * ZZRCT(:,:,:) &
- * ZLBDAR(:,:,:)**XEXCACCR &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), ZFCACCR * ZZRCT(:,:,:) &
+ * ZLBDAR(:,:,:)**ZEXCACCR &
* PRHODREF(:,:,:)**(-KCEXVT) )
ZDIM(:,:,:) = XACCR1 / ZLBDAR(:,:,:)
END WHERE
@@ -871,7 +874,7 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
ZZW5(:,:,:) = ZLBDC3(:,:,:) / ZLBDR3(:,:,:)
ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**2) * PRHODREF(:,:,:)
ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW5(:,:,:)), &
- PRCS(:,:,:))
+ PRCT(:,:,:))
END WHERE
! Accretion for D < 100 10-6 m
WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3) .AND. &
@@ -881,17 +884,17 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
ZZW5(:,:,:) = (ZLBDC3(:,:,:) / ZLBDR3(:,:,:))**2
ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**3) * PRHODREF(:,:,:)
ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW5(:,:,:)), &
- PRCS(:,:,:))
+ PRCT(:,:,:))
END WHERE
!
ELSE ! 1-moment schemes
!
ZLBDR(:,:,:) = 0.0
WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRRT(:,:,:) > KRTMIN(3)) &
- .AND. (PRCS(:,:,:) > 0.0))
+ .AND. (PRCT(:,:,:) > 0.0))
ZLBDR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XFCACCR * ZZRCT(:,:,:) &
- * ZLBDR(:,:,:)**XEXCACCR &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), ZFCACCR * ZZRCT(:,:,:) &
+ * ZLBDR(:,:,:)**ZEXCACCR &
* PRHODREF(:,:,:)**(-KCEXVT) )
END WHERE
END IF
@@ -960,7 +963,7 @@ ZWEVAP(:,:,:) = MAX(ZWEVAP(:,:,:), 0.0)
! no partial cloud evaporation at this stage
!
ZMASK(:,:,:) = 0.
-WHERE(PRCS(:,:,:) .LT. KRTMIN(2))
+WHERE(PRCT(:,:,:) .LT. KRTMIN(2))
ZMASK(:,:,:) = 1.
END WHERE
!
diff --git a/ext/aircraft_balloon_evol.f90 b/ext/aircraft_balloon_evol.f90
index 34e4aeb15b940fc1ed14750ff8701e0b51300ae7..d59b33721819904ac9baabd7719c0572b91a2433 100644
--- a/ext/aircraft_balloon_evol.f90
+++ b/ext/aircraft_balloon_evol.f90
@@ -25,6 +25,7 @@
! -PSEA was always used even if not allocated (CSURF/=EXTE)
! -do not use PMAP if cartesian domain
! P. Wautelet 06/2022: reorganize flyers
+! P. Wautelet 01/06/2023: deduplicate code => moved to modd/mode_sensors.f90
!-----------------------------------------------------------------
! ##########################
MODULE MODE_AIRCRAFT_BALLOON_EVOL
@@ -154,6 +155,7 @@ REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZV ! V points z coordinates
REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZWM ! mass point wind
!
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZEXN ! Exner function
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTH_EXN ! potential temperature multiplied by Exner function
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRHO ! air density
REAL :: ZFLYER_EXN ! balloon/aircraft Exner func.
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTHW_FLUX !
@@ -161,7 +163,6 @@ REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRCW_FLUX !
REAL, DIMENSION(2,2,SIZE(PSV,3),SIZE(PSV,4)) :: ZSVW_FLUX
!
LOGICAL :: GLAUNCH ! launch/takeoff is effective at this time-step (if true)
-LOGICAL :: GSTORE ! storage occurs at this time step
LOGICAL :: GOWNER_CUR ! The process is the current owner of the flyer
!
INTEGER :: II_M ! mass balloon position (x index)
@@ -169,37 +170,6 @@ INTEGER :: IJ_M ! mass balloon position (y index)
INTEGER :: II_U ! U flux point balloon position (x index)
INTEGER :: IJ_V ! V flux point balloon position (y index)
!
-INTEGER :: IK00 ! balloon position for II_M , IJ_M
-INTEGER :: IK01 ! balloon position for II_M , IJ_M+1
-INTEGER :: IK10 ! balloon position for II_M+1, IJ_M
-INTEGER :: IK11 ! balloon position for II_M+1, IJ_M+1
-INTEGER :: IU00 ! balloon position for II_U , IJ_M
-INTEGER :: IU01 ! balloon position for II_U , IJ_M+1
-INTEGER :: IU10 ! balloon position for II_U+1, IJ_M
-INTEGER :: IU11 ! balloon position for II_U+1, IJ_M+1
-INTEGER :: IV00 ! balloon position for II_M , IJ_V
-INTEGER :: IV01 ! balloon position for II_M , IJ_V+1
-INTEGER :: IV10 ! balloon position for II_M+1, IJ_V
-INTEGER :: IV11 ! balloon position for II_M+1, IJ_V+1
-!
-REAL :: ZXCOEF ! X direction interpolation coefficient
-REAL :: ZUCOEF ! X direction interpolation coefficient (for U)
-REAL :: ZYCOEF ! Y direction interpolation coefficient
-REAL :: ZVCOEF ! Y direction interpolation coefficient (for V)
-!
-REAL :: ZZCOEF00 ! Z direction interpolation coefficient for II_M , IJ_M
-REAL :: ZZCOEF01 ! Z direction interpolation coefficient for II_M , IJ_M+1
-REAL :: ZZCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_M
-REAL :: ZZCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_M+1
-REAL :: ZUCOEF00 ! Z direction interpolation coefficient for II_U , IJ_M
-REAL :: ZUCOEF01 ! Z direction interpolation coefficient for II_U , IJ_M+1
-REAL :: ZUCOEF10 ! Z direction interpolation coefficient for II_U+1, IJ_M
-REAL :: ZUCOEF11 ! Z direction interpolation coefficient for II_U+1, IJ_M+1
-REAL :: ZVCOEF00 ! Z direction interpolation coefficient for II_M , IJ_V
-REAL :: ZVCOEF01 ! Z direction interpolation coefficient for II_M , IJ_V+1
-REAL :: ZVCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_V
-REAL :: ZVCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_V+1
-!
INTEGER :: ISTORE ! time index for storage
!
REAL :: ZTSTEP
@@ -237,10 +207,13 @@ SELECT TYPE ( TPFLYER )
END IF TAKEOFF
!Do we have to store aircraft data?
- IF ( IMI == TPFLYER%NMODEL ) CALL FLYER_CHECK_STORESTEP( TPFLYER )
+ IF ( IMI == TPFLYER%NMODEL ) THEN
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
+ END IF
+
! For aircrafts, data has only to be computed at store moments
- ISTORE = TPFLYER%TFLYER_TIME%N_CUR
IF ( IMI == TPFLYER%NMODEL .AND. TPFLYER%LFLY .AND. TPFLYER%LSTORE ) THEN
! Check if it is the right moment to store data
IF ( ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
@@ -316,7 +289,8 @@ SELECT TYPE ( TPFLYER )
IF ( TPFLYER%NMODEL == IMI .AND. &
( .NOT. TPFLYER%LFLY .OR. TPFLYER%LCRASH .OR. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) ) THEN
!Do we have to store balloon data?
- CALL FLYER_CHECK_STORESTEP( TPFLYER )
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
END IF
! In flight
@@ -344,7 +318,7 @@ SELECT TYPE ( TPFLYER )
TPFLYER%LFLY = .FALSE.
WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
's (too low or too high)' )" ) &
- TRIM( TPFLYER%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ TRIM( TPFLYER%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
ELSE CRASH_VERT
!No vertical crash
@@ -386,34 +360,22 @@ IMPLICIT NONE
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+LOGICAL :: GLOW, GHIGH
+
SELECT CASE ( TPBALLOON%CTYPE )
!
! Iso-density balloon
!
CASE ( 'ISODEN' )
IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
- IK00 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,2,:)), 1)
- ZZCOEF00 = (TPBALLOON%XALTLAUNCH - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XALTLAUNCH - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XALTLAUNCH - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XALTLAUNCH - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00))
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01))
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10))
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH )
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE
- CMNHMSG(1) = 'Error in balloon initial position (balloon ' // TRIM(TPBALLOON%CTITLE) // ' )'
+ CMNHMSG(1) = 'Error in balloon initial position (balloon ' // TRIM(TPBALLOON%CNAME) // ' )'
CMNHMSG(2) = 'neither initial ALTITUDE or PRESsure is given'
CMNHMSG(3) = 'Check your INI_BALLOON routine'
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
@@ -427,65 +389,70 @@ SELECT CASE ( TPBALLOON%CTYPE )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+ IF ( TPBALLOON%XZ_CUR > TPBALLOON%XALTLAUNCH ) THEN
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3, " (instead of ", EN12.3, ")" )' ) TPBALLOON%XZ_CUR, TPBALLOON%XALTLAUNCH
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+ END IF
!
! Constant Volume Balloon
!
CASE ( 'CVBALL' )
IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
- IK00 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = TPBALLOON%XALTLAUNCH
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3, " (instead of ", EN12.3, ")" )' ) TPBALLOON%XZ_CUR, TPBALLOON%XALTLAUNCH
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (TPBALLOON%XALTLAUNCH - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XALTLAUNCH - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XALTLAUNCH - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XALTLAUNCH - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3 )' ) TPBALLOON%XZ_CUR
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XZ_CUR, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00))
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01))
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10))
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE
TPBALLOON%XRHO = TPBALLOON%XMASS / TPBALLOON%XVOLUME
- IK00 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XRHO, ZRHO, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3 )' ) TPBALLOON%XZ_CUR
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XZ_CUR, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (TPBALLOON%XRHO - ZRHO(1,1,IK00)) / ( ZRHO(1,1,IK00+1) - ZRHO(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XRHO - ZRHO(1,2,IK01)) / ( ZRHO(1,2,IK01+1) - ZRHO(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XRHO - ZRHO(2,1,IK10)) / ( ZRHO(2,1,IK10+1) - ZRHO(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XRHO - ZRHO(2,2,IK11)) / ( ZRHO(2,2,IK11+1) - ZRHO(2,2,IK11))
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
END IF
END SELECT
@@ -516,10 +483,10 @@ REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
ZTSTEP = PTSTEP
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
+ZU_BAL = TPBALLOON%INTERP_FROM_UPOINT( PU )
+ZV_BAL = TPBALLOON%INTERP_FROM_VPOINT( PV )
if ( .not. lcartesian ) then
- ZMAP = FLYER_INTERP_2D(PMAP)
+ ZMAP = TPBALLOON%INTERP_HOR_FROM_MASSPOINT( PMAP )
else
ZMAP = 1.
end if
@@ -541,7 +508,7 @@ CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPBALLOON )
IF ( TPBALLOON%LCRASH ) THEN
WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
's (out of the horizontal boundaries)' )" ) &
- TRIM( TPBALLOON%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ TRIM( TPBALLOON%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
@@ -581,8 +548,8 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
TPBALLOON%TFLYER_TIME%TPDATES(ISTORE) = TPBALLOON%TFLYER_TIME%TPDATES(ISTORE-1) + TPBALLOON%TFLYER_TIME%XTSTEP
WRITE( CMNHMSG(1), "( 'Balloon ', A, ': store skipped at ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
- TRIM( TPBALLOON%CTITLE ), &
- TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NDAY, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NMONTH, &
+ TRIM( TPBALLOON%CNAME ), &
+ TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NDAY, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NMONTH, &
TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NYEAR, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%XTIME
CMNHMSG(2) = 'due to change of model (child to its parent)'
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
@@ -600,13 +567,13 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
IF ( TPBALLOON%LCRASH ) THEN
WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
's (out of the horizontal boundaries)' )" ) &
- TRIM( TPBALLOON%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ TRIM( TPBALLOON%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
ELSE
! Special case not-managed (different dads, change of several models in 1 step (going to grand parent/grand children)...)
! This situation should be very infrequent => reasonable risk, error on the trajectory should be relatively small in most cases
- CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CTITLE
+ CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CNAME
CMNHMSG(2) = 'its trajectory might be wrong'
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
@@ -629,13 +596,13 @@ REAL :: ZRO_BAL ! air density at balloon location
REAL :: ZW_BAL ! vertical wind speed at balloon location (along z)
IF ( TPBALLOON%CTYPE == 'RADIOS' ) THEN
- ZW_BAL = FLYER_INTERP(ZWM)
+ ZW_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZWM )
TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * ZTSTEP
END IF
IF ( TPBALLOON%CTYPE == 'CVBALL' ) THEN
- ZW_BAL = FLYER_INTERP(ZWM)
- ZRO_BAL = FLYER_INTERP(ZRHO)
+ ZW_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZWM )
+ ZRO_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
! calculation with a time step of 1 second or less
IF (INT(ZTSTEP) .GT. 1 ) THEN
DO JK=1,INT(ZTSTEP)
@@ -680,12 +647,17 @@ IKE = SIZE(PZ,3) - JPVEXT
! ------------------------------------------------
! X position
-II_U = COUNT( XXHAT (:) <= TPFLYER%XX_CUR )
-II_M = COUNT( XXHATM(:) <= TPFLYER%XX_CUR )
+TPFLYER%NI_U = COUNT( XXHAT (:) <= TPFLYER%XX_CUR )
+TPFLYER%NI_M = COUNT( XXHATM(:) <= TPFLYER%XX_CUR )
+II_U = TPFLYER%NI_U
+II_M = TPFLYER%NI_M
! Y position
-IJ_V=COUNT( XYHAT (:)<=TPFLYER%XY_CUR )
-IJ_M=COUNT( XYHATM(:)<=TPFLYER%XY_CUR )
+TPFLYER%NJ_V = COUNT( XYHAT (:)<=TPFLYER%XY_CUR )
+TPFLYER%NJ_M = COUNT( XYHATM(:)<=TPFLYER%XY_CUR )
+IJ_V = TPFLYER%NJ_V
+IJ_M = TPFLYER%NJ_M
+
ZZM(:,:,1:IKU-1)=0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,1:IKU-1)+0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,2:IKU )
ZZM(:,:, IKU )=1.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-1)-0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-2)
@@ -765,20 +737,20 @@ USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
IMPLICIT NONE
! Interpolation coefficient for X
-ZXCOEF = (TPFLYER%XX_CUR - XXHATM(II_M)) / (XXHATM(II_M+1) - XXHATM(II_M))
-ZXCOEF = MAX (0.,MIN(ZXCOEF,1.))
+TPFLYER%XXMCOEF = ( TPFLYER%XX_CUR - XXHATM(II_M) ) / ( XXHATM(II_M+1) - XXHATM(II_M) )
+TPFLYER%XXMCOEF = MAX( 0., MIN( TPFLYER%XXMCOEF, 1. ) )
! Interpolation coefficient for y
-ZYCOEF = (TPFLYER%XY_CUR - XYHATM(IJ_M)) / (XYHATM(IJ_M+1) - XYHATM(IJ_M))
-ZYCOEF = MAX (0.,MIN(ZYCOEF,1.))
+TPFLYER%XYMCOEF = ( TPFLYER%XY_CUR - XYHATM(IJ_M) ) / ( XYHATM(IJ_M+1) - XYHATM(IJ_M) )
+TPFLYER%XYMCOEF = MAX( 0., MIN( TPFLYER%XYMCOEF, 1. ) )
! Interpolation coefficient for X (for U)
-ZUCOEF = (TPFLYER%XX_CUR - XXHAT(II_U)) / (XXHAT(II_U+1) - XXHAT(II_U))
-ZUCOEF = MAX(0.,MIN(ZUCOEF,1.))
+TPFLYER%XXUCOEF = ( TPFLYER%XX_CUR - XXHAT(II_U) ) / ( XXHAT(II_U+1) - XXHAT(II_U) )
+TPFLYER%XXUCOEF = MAX( 0., MIN( TPFLYER%XXUCOEF, 1. ) )
! Interpolation coefficient for y (for V)
-ZVCOEF = (TPFLYER%XY_CUR - XYHAT(IJ_V)) / (XYHAT(IJ_V+1) - XYHAT(IJ_V))
-ZVCOEF = MAX(0.,MIN(ZVCOEF,1.))
+TPFLYER%XYVCOEF = ( TPFLYER%XY_CUR - XYHAT(IJ_V) ) / ( XYHAT(IJ_V+1) - XYHAT(IJ_V) )
+TPFLYER%XYVCOEF = MAX( 0., MIN( TPFLYER%XYVCOEF, 1. ) )
END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1
!----------------------------------------------------------------------------
@@ -791,97 +763,46 @@ USE MODD_TIME_n, ONLY: TDTCUR
IMPLICIT NONE
+LOGICAL :: GLOW, GHIGH
+
! Find indices surrounding the vertical box where the flyer is
SELECT TYPE ( TPFLYER )
CLASS IS ( TAIRCRAFTDATA)
IF ( TPFLYER%LALTDEF ) THEN
ZFLYER_EXN = (TPFLYER%XP_CUR/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
ELSE
- IK00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XZ_CUR, ZZM, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END IF
CLASS IS ( TBALLOONDATA)
IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- IK00 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XRHO, ZRHO, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
- IK00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XZ_CUR, ZZM, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END IF
END SELECT
-! Do not allow crash on the ground: set position on the ground if too low
-IF ( ANY( [ IK00, IK01, IK10, IK11 ] < IKB ) ) THEN
- !Minimum altitude is on the ground at IKB (no crash if too low)
- IK00 = MAX ( IK00, IKB )
- IK01 = MAX ( IK01, IKB )
- IK10 = MAX ( IK10, IKB )
- IK11 = MAX ( IK11, IKB )
-
- CMNHMSG(1) = 'flyer ' // TRIM( TPFLYER%CTITLE ) // ' is near the ground'
- WRITE( CMNHMSG(2), "( 'at ', I2, '/', I2, '/', I4, ' ', F18.12, 's' )" ) &
- TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'FLYER_COMPUTE_INTERP_COEFF_VER', OLOCAL = .TRUE. )
-END IF
-
-! ! Check if the flyer crashed vertically (lower bound)
-! IF (IK00 < IKB .OR. IK01 < IKB .OR. IK10 < IKB .OR. IK11 < IKB ) THEN
-! TPFLYER%LCRASH = .TRUE.
-! TPFLYER%NCRASH = NCRASH_OUT_LOW
-! END IF
-
! Check if the flyer crashed vertically (higher bound)
-IF (IK00 >= IKE .OR. IK01 >= IKE .OR. IK10 >= IKE .OR. IK11 >= IKE ) THEN
+IF ( GHIGH ) THEN
TPFLYER%LCRASH = .TRUE.
TPFLYER%NCRASH = NCRASH_OUT_HIGH
END IF
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TBALLOONDATA)
- IF ( TPFLYER%LCRASH ) RETURN
-END SELECT
-
-! Interpolation coefficients for the 4 suroundings verticals
SELECT TYPE ( TPFLYER )
CLASS IS ( TAIRCRAFTDATA)
IF ( TPFLYER%LALTDEF ) THEN
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00) )
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01) )
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10) )
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11) )
- TPFLYER%XZ_CUR = FLYER_INTERP(ZZM)
+ TPFLYER%XZ_CUR = TPFLYER%INTERP_FROM_MASSPOINT( ZZM )
ELSE
- ZZCOEF00 = (TPFLYER%XZ_CUR - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XZ_CUR - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XZ_CUR - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XZ_CUR - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11) )
- TPFLYER%XP_CUR = FLYER_INTERP(PP)
+ TPFLYER%XP_CUR = TPFLYER%INTERP_FROM_MASSPOINT( PP )
END IF
CLASS IS ( TBALLOONDATA)
IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- ZZCOEF00 = (TPFLYER%XRHO - ZRHO(1,1,IK00)) / ( ZRHO(1,1,IK00+1) - ZRHO(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XRHO - ZRHO(1,2,IK01)) / ( ZRHO(1,2,IK01+1) - ZRHO(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XRHO - ZRHO(2,1,IK10)) / ( ZRHO(2,1,IK10+1) - ZRHO(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XRHO - ZRHO(2,2,IK11)) / ( ZRHO(2,2,IK11+1) - ZRHO(2,2,IK11) )
- TPFLYER%XZ_CUR = FLYER_INTERP(ZZM)
+ TPFLYER%XZ_CUR = TPFLYER%INTERP_FROM_MASSPOINT( ZZM )
ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
- ZZCOEF00 = (TPFLYER%XZ_CUR - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XZ_CUR - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XZ_CUR - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XZ_CUR - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11) )
+ !Nothing to do
END IF
END SELECT
@@ -895,96 +816,38 @@ SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
IMPLICIT NONE
-! Interpolation coefficients for the 4 suroundings verticals (for U)
-IU00 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(1,1,:)), 1)
-IU01 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(1,2,:)), 1)
-IU10 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(2,1,:)), 1)
-IU11 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(2,2,:)), 1)
-ZUCOEF00 = (TPFLYER%XZ_CUR - ZZU(1,1,IU00)) / ( ZZU(1,1,IU00+1) - ZZU(1,1,IU00) )
-ZUCOEF01 = (TPFLYER%XZ_CUR - ZZU(1,2,IU01)) / ( ZZU(1,2,IU01+1) - ZZU(1,2,IU01) )
-ZUCOEF10 = (TPFLYER%XZ_CUR - ZZU(2,1,IU10)) / ( ZZU(2,1,IU10+1) - ZZU(2,1,IU10) )
-ZUCOEF11 = (TPFLYER%XZ_CUR - ZZU(2,2,IU11)) / ( ZZU(2,2,IU11+1) - ZZU(2,2,IU11) )
+LOGICAL :: GLOW, GHIGH
+
+! Interpolation coefficients for the 4 surroundings verticals (for U)
+! ODONOLOWCRASH = .TRUE. because check for low crash has already been done
+CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'U', TPFLYER%XZ_CUR, ZZU, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
! Interpolation coefficients for the 4 suroundings verticals (for V)
-IV00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(1,1,:)), 1)
-IV01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(1,2,:)), 1)
-IV10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(2,1,:)), 1)
-IV11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(2,2,:)), 1)
-ZVCOEF00 = (TPFLYER%XZ_CUR - ZZV(1,1,IV00)) / ( ZZV(1,1,IV00+1) - ZZV(1,1,IV00) )
-ZVCOEF01 = (TPFLYER%XZ_CUR - ZZV(1,2,IV01)) / ( ZZV(1,2,IV01+1) - ZZV(1,2,IV01) )
-ZVCOEF10 = (TPFLYER%XZ_CUR - ZZV(2,1,IV10)) / ( ZZV(2,1,IV10+1) - ZZV(2,1,IV10) )
-ZVCOEF11 = (TPFLYER%XZ_CUR - ZZV(2,2,IV11)) / ( ZZV(2,2,IV11+1) - ZZV(2,2,IV11) )
+CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'V', TPFLYER%XZ_CUR, ZZV, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE FLYER_RECORD_DATA( )
-USE MODD_CST, ONLY: XCPD, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XTT
-USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
+USE MODD_CST, ONLY: XP00, XPI, XRD
+USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_TKE_DISS
USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I => LSNOW_T
-USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
- XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
- XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
- XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY: XAI_L => XAI, XBI_L => XBI, XLBEXS_L => XLBEXS,XLBS_L => XLBS,XCCS_L => XCCS, &
- XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
- XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
- XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED, ONLY: XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG
-USE MODD_PARAM_LIMA_WARM, ONLY: XAC_L => XAC, XAR_L => XAR, XBC_L => XBC, XBR_L => XBR
-USE MODD_PARAM_n, ONLY: CCLOUD, CSURF
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
- XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
- XALPHAC_I => XALPHAC, XNUC_I => XNUC, XBC_I => XBC, XAC_I => XAC, &
- XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
- XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
- XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
- XALPHAG_I => XALPHAG, XNUG_I => XNUG, XLBEXG_I => XLBEXG, &
- XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, &
- XALPHAI_I => XALPHAI, XNUI_I => XNUI, XLBEXI_I => XLBEXI, &
- XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, &
- XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
- XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
- XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
-
-USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: BHMIE, MOMG, MG, QEPSI, QEPSW
-USE MODE_GRIDPROJ, ONLY: SM_LATLON
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
-USE MODI_GAMMA, ONLY: GAMMA
+USE MODE_GRIDPROJ, ONLY: SM_LATLON
+USE MODE_SENSOR, ONLY: Sensor_rare_compute, Sensor_wc_compute
IMPLICIT NONE
-INTEGER, PARAMETER :: JPTS_GAULAG = 7 ! number of points for Gauss-Laguerre quadrature
-
-INTEGER :: JK ! loop index
INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
-REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
-REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
-REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
-REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
-REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
-REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
-INTEGER :: JJ ! loop counter for quadrature
-COMPLEX :: QMW,QMI,QM,QEPSIW,QEPSWI ! dielectric parameter
-REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
-REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
-REAL :: ZFW ! liquid fraction
-REAL :: ZFPW ! weight for mixed-phase reflectivity
-REAL :: ZN ! number concentration
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
-LOGICAL :: GCALC
REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
+REAL, DIMENSION(SIZE(PZ,3)) :: ZZ ! altitude of model levels at station location
+REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
TPFLYER%NMODELHIST(ISTORE) = TPFLYER%NMODEL
@@ -992,496 +855,75 @@ TPFLYER%XX(ISTORE) = TPFLYER%XX_CUR
TPFLYER%XY(ISTORE) = TPFLYER%XY_CUR
TPFLYER%XZ(ISTORE) = TPFLYER%XZ_CUR
!
-CALL SM_LATLON(PLATOR,PLONOR, &
- TPFLYER%XX_CUR, TPFLYER%XY_CUR, &
- TPFLYER%XLAT(ISTORE), TPFLYER%XLON(ISTORE) )
+CALL SM_LATLON( PLATOR, PLONOR, &
+ TPFLYER%XX_CUR, TPFLYER%XY_CUR, &
+ TPFLYER%XLAT_CUR, TPFLYER%XLON_CUR )
+TPFLYER%XLAT(ISTORE) = TPFLYER%XLAT_CUR
+TPFLYER%XLON(ISTORE) = TPFLYER%XLON_CUR
!
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
-ZGAM = (XRPK * (TPFLYER%XLON(ISTORE) - XLON0) - XBETA)*(XPI/180.)
-TPFLYER%XZON (ISTORE) = ZU_BAL * COS(ZGAM) + ZV_BAL * SIN(ZGAM)
-TPFLYER%XMER (ISTORE) = - ZU_BAL * SIN(ZGAM) + ZV_BAL * COS(ZGAM)
+ZU_BAL = TPFLYER%INTERP_FROM_UPOINT( PU )
+ZV_BAL = TPFLYER%INTERP_FROM_VPOINT( PV )
+ZGAM = (XRPK * (TPFLYER%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
+TPFLYER%XZON (1,ISTORE) = ZU_BAL * COS(ZGAM) + ZV_BAL * SIN(ZGAM)
+TPFLYER%XMER (1,ISTORE) = - ZU_BAL * SIN(ZGAM) + ZV_BAL * COS(ZGAM)
!
-TPFLYER%XW (ISTORE) = FLYER_INTERP(ZWM)
-TPFLYER%XTH (ISTORE) = FLYER_INTERP(PTH)
+TPFLYER%XW (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZWM )
+TPFLYER%XTH (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PTH )
!
-ZFLYER_EXN = FLYER_INTERP(ZEXN)
-TPFLYER%XP (ISTORE) = XP00 * ZFLYER_EXN**(XCPD/XRD)
+ZFLYER_EXN = TPFLYER%INTERP_FROM_MASSPOINT( ZEXN )
+TPFLYER%XP (1,ISTORE) = XP00 * ZFLYER_EXN**(XCPD/XRD)
ZR(:,:,:) = 0.
DO JLOOP=1,SIZE(PR,4)
- TPFLYER%XR (ISTORE,JLOOP) = FLYER_INTERP(PR(:,:,:,JLOOP))
+ TPFLYER%XR (1,ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
IF (JLOOP>=2) ZR(:,:,:) = ZR(:,:,:) + PR(:,:,:,JLOOP)
END DO
DO JLOOP=1,SIZE(PSV,4)
- TPFLYER%XSV (ISTORE,JLOOP) = FLYER_INTERP(PSV(:,:,:,JLOOP))
+ TPFLYER%XSV (1,ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( PSV(:,:,:,JLOOP) )
END DO
-TPFLYER%XRTZ (ISTORE,:) = FLYER_INTERPZ(ZR(:,:,:))
+TPFLYER%XRTZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZR(:,:,:) )
DO JLOOP=1,SIZE(PR,4)
- TPFLYER%XRZ (ISTORE,:,JLOOP) = FLYER_INTERPZ(PR(:,:,:,JLOOP))
+ TPFLYER%XRZ (:,ISTORE,JLOOP) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
END DO
-TPFLYER%XFFZ (ISTORE,:) = FLYER_INTERPZ(SQRT(PU**2+PV**2))
+TPFLYER%XFFZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( SQRT(PU**2+PV**2) )
+
+TPFLYER%XRHOD (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PRHODREF )
IF (CCLOUD=="LIMA") THEN
- TPFLYER%XCIZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
- TPFLYER%XCCZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
- TPFLYER%XCRZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
+ TPFLYER%XCIZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ TPFLYER%XCCZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ TPFLYER%XCRZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
- TPFLYER%XCIZ (ISTORE,:) = FLYER_INTERPZ(PCIT(:,:,:))
+ TPFLYER%XCIZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PCIT(:,:,:) )
END IF
-! initialization CRARE and CRARE_ATT + LWC and IWC
-TPFLYER%XCRARE(ISTORE,:) = 0.
-TPFLYER%XCRARE_ATT(ISTORE,:) = 0.
-TPFLYER%XLWCZ (ISTORE,:) = 0.
-TPFLYER%XIWCZ (ISTORE,:) = 0.
-IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
- TPFLYER%XLWCZ (ISTORE,:) = FLYER_INTERPZ((PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:))
- TPFLYER%XIWCZ (ISTORE,:) = FLYER_INTERPZ((PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:))
- ZTEMPZ(:)=FLYER_INTERPZ(PTH(II_M:II_M+1,IJ_M:IJ_M+1,:) * ZEXN(:,:,:))
- ZRHODREFZ(:)=FLYER_INTERPZ(PRHODREF(:,:,:))
- IF (CCLOUD=="LIMA") THEN
- ZCCI(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
- ZCCR(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
- ZCCC(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
- ELSE
- ZCIT(:)=FLYER_INTERPZ(PCIT(:,:,:))
- ENDIF
- DO JLOOP=3,6
- ZRZ(:,JLOOP)=FLYER_INTERPZ(PR(:,:,:,JLOOP))
- END DO
- if ( csurf == 'EXTE' ) then
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2)*PSEA(:,:)) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=FLYER_INTERP_2D(PR(:,:,JK,2)*(1.-PSEA(:,:))) ! becomes cloud mixing ratio over land
- END DO
- else
- !if csurf/='EXTE', psea is not allocated
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2))
- ZRZ(JK,7) = 0.
- END DO
- end if
- ALLOCATE(ZAELOC(IKU))
- !
- ZAELOC(:)=0.
- ! initialization of quadrature points and weights
- ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
- CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
- ! initialize minimum values
- ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
- IF (CCLOUD == 'LIMA') THEN
- ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_L(3)
- ZRTMIN(4)=XRTMIN_L(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_L(6)
- ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
- ELSE
- ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_I(3)
- ZRTMIN(4)=XRTMIN_I(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_I(6)
- ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
- ENDIF
- ! compute cloud radar reflectivity from vertical profiles of temperature and mixing ratios
- DO JK=1,IKU
- QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- DO JLOOP=2,7
- IF (CCLOUD == 'LIMA') THEN
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
- (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND. JLOOP.NE.7).OR.ZCCC(JK)>0.))
- ELSE
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
- ENDIF
- IF(GCALC) THEN
- SELECT CASE(JLOOP)
- CASE(2) ! cloud water over sea
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_SEA
- ZCX=0.
- ZALPHA=XALPHAC2_I
- ZNU=XNUC2_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ENDIF
- CASE(3) ! rain water
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAR_L
- ZB=XBR_L
- ZCC=ZCCR(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAR_L
- ZNU=XNUR_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAR_I
- ZB=XBR_I
- ZCC=XCCR_I
- ZCX=-1.
- ZALPHA=XALPHAR_I
- ZNU=XNUR_I
- ZLB=XLBR_I
- ZLBEX=XLBEXR_I
- ENDIF
- CASE(4) ! pristine ice
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAI_L
- ZB=XBI_L
- ZCC=ZCCI(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAI_L
- ZNU=XNUI_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ELSE
- ZA=XAI_I
- ZB=XBI_I
- ZCC=ZCIT(JK)
- ZCX=0.
- ZALPHA=XALPHAI_I
- ZNU=XNUI_I
- ZLBEX=XLBEXI_I
- ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ENDIF
- CASE(5) ! snow
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAS_L
- ZB=XBS_L
- ZCC=XCCS_L
- ZCX=XCXS_L
- ZALPHA=XALPHAS_L
- ZNU=XNUS_L
- ZNS=XNS_L
- ZLB=XLBS_L
- ZLBEX=XLBEXS_L
- ZFW=0
- ELSE
- ZA=XAS_I
- ZB=XBS_I
- ZCC=XCCS_I
- ZCX=XCXS_I
- ZALPHA=XALPHAS_I
- ZNU=XNUS_I
- ZNS=XNS_I
- ZLB=XLBS_I
- ZLBEX=XLBEXS_I
- ZFW=0
- ENDIF
- CASE(6) ! graupel
- !If temperature between -10 and 10°C and Mr and Mg over min threshold: melting graupel
- ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel (Fw=0)
- IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
- .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
- ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
- ELSE
- ZFW=0
- ENDIF
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAG_L
- ZB=XBG_L
- ZCC=XCCG_L
- ZCX=XCXG_L
- ZALPHA=XALPHAG_L
- ZNU=XNUG_L
- ZLB=XLBG_L
- ZLBEX=XLBEXG_L
- ELSE
- ZA=XAG_I
- ZB=XBG_I
- ZCC=XCCG_I
- ZCX=XCXG_I
- ZALPHA=XALPHAG_I
- ZNU=XNUG_I
- ZLB=XLBG_I
- ZLBEX=XLBEXG_I
- ENDIF
- CASE(7) ! cloud water over land
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_LAND
- ZCX=0.
- ZALPHA=XALPHAC_I
- ZNU=XNUC_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ENDIF
- END SELECT
- IF ( JLOOP == 5 .AND. CCLOUD=='LIMA'.AND.LSNOW_T_L ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE IF (JLOOP.EQ.5 .AND. (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE
- ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
- ZN=ZCC*ZLBDA**ZCX
- END IF
- ZREFLOC=0.
- ZAETMP=0.
- DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
- ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
- SELECT CASE(JLOOP)
- CASE(2,3,7)
- QM=QMW
- CASE(4,5,6)
- ! pristine ice, snow, dry graupel
- ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
- QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
-
- ! water inclusions in ice in air
- QEPSWI=MG(QMW**2,QM**2,ZFW)
- ! ice in air inclusions in water
- QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
-
- !MG weighted rule (Matrosov 2008)
- IF(ZFW .LT. 0.37) THEN
- ZFPW=0
- ELSE IF(ZFW .GT. 0.63) THEN
- ZFPW=1
- ELSE
- ZFPW=(ZFW-0.37)/(0.63-0.37)
- ENDIF
- QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
- END SELECT
- CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
- ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- END DO
- ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93)
- ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU))
- TPFLYER%XCRARE(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)+ZREFLOC
- ZAELOC(JK)=ZAELOC(JK)+ZAETMP
- END IF
- END DO
- END DO
-
- ! apply attenuation
- ALLOCATE(ZZMZ(IKU))
- ZZMZ(:)=FLYER_INTERPZ(ZZM(:,:,:))
- ! nadir
- ZAETOT=1.
- DO JK=COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1,-1
- IF(JK.EQ.COUNT(TPFLYER%XZ_CUR >= ZZMZ(:))) THEN
- IF(TPFLYER%XZ_CUR<=ZZMZ(JK)+.5*(ZZMZ(JK+1)-ZZMZ(JK))) THEN
- ! only attenuation from ZAELOC(JK)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(TPFLYER%XZ_CUR-ZZMZ(JK))))
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK+1)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK+1)*(TPFLYER%XZ_CUR-.5*(ZZMZ(JK+1)+ZZMZ(JK))) &
- +ZAELOC(JK)*.5*(ZZMZ(JK+1)-ZZMZ(JK))))
- END IF
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK+1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK+1)+ZAELOC(JK))*(ZZMZ(JK+1)-ZZMZ(JK)))
- END IF
- TPFLYER%XCRARE_ATT(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)*ZAETOT
- END DO
- ! zenith
- ZAETOT=1.
- DO JK = MAX(COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1)+1,IKU
- IF ( JK .EQ. (MAX(COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1)+1) ) THEN
- IF(TPFLYER%XZ_CUR>=ZZMZ(JK)-.5*(ZZMZ(JK)-ZZMZ(JK-1))) THEN
- ! only attenuation from ZAELOC(JK)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(ZZMZ(JK)-TPFLYER%XZ_CUR)))
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK-1)*(.5*(ZZMZ(JK)+ZZMZ(JK-1))-TPFLYER%XZ_CUR) &
- +ZAELOC(JK)*.5*(ZZMZ(JK)-ZZMZ(JK-1))))
- END IF
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
- END IF
- TPFLYER%XCRARE_ATT(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)*ZAETOT
- END DO
-
- TPFLYER%XZZ (ISTORE,:) = ZZMZ(:)
- DEALLOCATE(ZZMZ,ZAELOC)
- ! m^3 → mm^6/m^3 → dBZ
- WHERE(TPFLYER%XCRARE(ISTORE,:)>0)
- TPFLYER%XCRARE(ISTORE,:)=10.*LOG10(1.E18*TPFLYER%XCRARE(ISTORE,:))
- ELSEWHERE
- TPFLYER%XCRARE(ISTORE,:)=XUNDEF
- END WHERE
- WHERE(TPFLYER%XCRARE_ATT(ISTORE,:)>0)
- TPFLYER%XCRARE_ATT(ISTORE,:)=10.*LOG10(1.E18*TPFLYER%XCRARE_ATT(ISTORE,:))
- ELSEWHERE
- TPFLYER%XCRARE_ATT(ISTORE,:)=XUNDEF
- END WHERE
- DEALLOCATE(ZX,ZW,ZRTMIN)
-END IF ! end LOOP ICE3
+
+ZTH_EXN(:,:,:) = PTH(TPFLYER%NI_M:TPFLYER%NI_M+1, TPFLYER%NJ_M:TPFLYER%NJ_M+1, :) * ZEXN(:,:,:)
+ZZ(:) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZZM(:,:,:) )
+TPFLYER%XZZ(:,ISTORE) = ZZ(:)
+
+CALL Sensor_wc_compute( TPFLYER, ISTORE, PR, PRHODREF )
+CALL Sensor_rare_compute( TPFLYER, ISTORE, PR, PSV, PRHODREF, PCIT, ZTH_EXN, ZZ, PSEA )
+
! vertical wind
-TPFLYER%XWZ (ISTORE,:) = FLYER_INTERPZ(ZWM(:,:,:))
-IF (SIZE(PTKE)>0) TPFLYER%XTKE (ISTORE) = FLYER_INTERP(PTKE)
-IF (SIZE(PTS) >0) TPFLYER%XTSRAD(ISTORE) = FLYER_INTERP_2D(PTS)
-IF (LDIAG_IN_RUN) TPFLYER%XTKE_DISS(ISTORE) = FLYER_INTERP(XCURRENT_TKE_DISS)
-TPFLYER%XZS(ISTORE) = FLYER_INTERP_2D(PZ(:,:,1+JPVEXT))
-TPFLYER%XTHW_FLUX(ISTORE) = FLYER_INTERP(ZTHW_FLUX)
-TPFLYER%XRCW_FLUX(ISTORE) = FLYER_INTERP(ZRCW_FLUX)
+TPFLYER%XWZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZWM(:,:,:) )
+
+! Dry air density at flyer position
+TPFLYER%XRHOD_SENSOR(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PRHODREF )
+
+IF (SIZE(PTKE)>0) TPFLYER%XTKE (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PTKE )
+IF ( CRAD /= 'NONE' ) TPFLYER%XTSRAD(ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT(PTS )
+TPFLYER%XTKE_DISS(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( XCURRENT_TKE_DISS )
+TPFLYER%XZS(ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PZ(:,:,1+JPVEXT) )
+TPFLYER%XTHW_FLUX(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZTHW_FLUX )
+TPFLYER%XRCW_FLUX(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZRCW_FLUX )
DO JLOOP=1,SIZE(PSV,4)
-TPFLYER%XSVW_FLUX(ISTORE,JLOOP) = FLYER_INTERP(ZSVW_FLUX(:,:,:,JLOOP))
+TPFLYER%XSVW_FLUX(ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( ZSVW_FLUX(:,:,:,JLOOP) )
END DO
END SUBROUTINE FLYER_RECORD_DATA
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZXCOEF) * ( (1.-ZZCOEF00) * PA(JI ,JJ ,IK00) + ZZCOEF00 * PA(JI ,JJ ,IK00+1)) &
- + (1.- ZYCOEF) * ( ZXCOEF) * ( (1.-ZZCOEF10) * PA(JI+1,JJ ,IK10) + ZZCOEF10 * PA(JI+1,JJ ,IK10+1)) &
- + ( ZYCOEF) * (1.-ZXCOEF) * ( (1.-ZZCOEF01) * PA(JI ,JJ+1,IK01) + ZZCOEF01 * PA(JI ,JJ+1,IK01+1)) &
- + ( ZYCOEF) * ( ZXCOEF) * ( (1.-ZZCOEF11) * PA(JI+1,JJ+1,IK11) + ZZCOEF11 * PA(JI+1,JJ+1,IK11+1))
-!
-END FUNCTION FLYER_INTERP
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERPZ(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL, DIMENSION(SIZE(PA,3)) :: PB
-!
-INTEGER :: JI, JJ, JK
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-!
-DO JK=1,SIZE(PA,3)
- IF ( (PA(JI,JJ,JK) /= XUNDEF) .AND. (PA(JI+1,JJ,JK) /= XUNDEF) .AND. &
- (PA(JI,JJ+1,JK) /= XUNDEF) .AND. (PA(JI+1,JJ+1,JK) /= XUNDEF) ) THEN
- PB(JK) = (1.-ZYCOEF) * (1.-ZXCOEF) * PA(JI,JJ,JK) + &
- (1.-ZYCOEF) * (ZXCOEF) * PA(JI+1,JJ,JK) + &
- (ZYCOEF) * (1.-ZXCOEF) * PA(JI,JJ+1,JK) + &
- (ZYCOEF) * (ZXCOEF) * PA(JI+1,JJ+1,JK)
- ELSE
- PB(JK) = XUNDEF
- END IF
-END DO
-!
-END FUNCTION FLYER_INTERPZ
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_U(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_U
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZUCOEF) * ( (1.-ZUCOEF00) * PA(JI ,JJ ,IU00) + ZUCOEF00 * PA(JI ,JJ ,IU00+1)) &
- + (1.- ZYCOEF) * ( ZUCOEF) * ( (1.-ZUCOEF10) * PA(JI+1,JJ ,IU10) + ZUCOEF10 * PA(JI+1,JJ ,IU10+1)) &
- + ( ZYCOEF) * (1.-ZUCOEF) * ( (1.-ZUCOEF01) * PA(JI ,JJ+1,IU01) + ZUCOEF01 * PA(JI ,JJ+1,IU01+1)) &
- + ( ZYCOEF) * ( ZUCOEF) * ( (1.-ZUCOEF11) * PA(JI+1,JJ+1,IU11) + ZUCOEF11 * PA(JI+1,JJ+1,IU11+1))
-!
-END FUNCTION FLYER_INTERP_U
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_V(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_V
-END IF
-!
-PB = (1.- ZVCOEF) * (1.-ZXCOEF) * ( (1.-ZVCOEF00) * PA(JI ,JJ ,IV00) + ZVCOEF00 * PA(JI ,JJ ,IV00+1)) &
- + (1.- ZVCOEF) * ( ZXCOEF) * ( (1.-ZVCOEF10) * PA(JI+1,JJ ,IV10) + ZVCOEF10 * PA(JI+1,JJ ,IV10+1)) &
- + ( ZVCOEF) * (1.-ZXCOEF) * ( (1.-ZVCOEF01) * PA(JI ,JJ+1,IV01) + ZVCOEF01 * PA(JI ,JJ+1,IV01+1)) &
- + ( ZVCOEF) * ( ZXCOEF) * ( (1.-ZVCOEF11) * PA(JI+1,JJ+1,IV11) + ZVCOEF11 * PA(JI+1,JJ+1,IV11+1))
-!
-END FUNCTION FLYER_INTERP_V
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_2D(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ ) &
- + (1.- ZYCOEF) * ( ZXCOEF) * PA(JI+1,JJ ) &
- + ( ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ+1) &
- + ( ZYCOEF) * ( ZXCOEF) * PA(JI+1,JJ+1)
-!
-END FUNCTION FLYER_INTERP_2D
-!----------------------------------------------------------------------------
-
END SUBROUTINE AIRCRAFT_BALLOON_EVOL
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
@@ -1591,30 +1033,5 @@ END IF
END SUBROUTINE FLYER_GET_RANK_MODEL_ISCRASHED
!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_CHECK_STORESTEP( TPFLYER )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
-
-INTEGER :: ISTORE
-
-!Remark: TPFLYER%TFLYER_TIME%N_CUR and %TPDATES are updated in STATPROF_INSTANT
-CALL STATPROF_INSTANT( TPFLYER%TFLYER_TIME, ISTORE )
-
-IF ( ISTORE < 1 ) THEN
- !No profiler storage at this time step
- TPFLYER%LSTORE = .FALSE.
-ELSE
- TPFLYER%LSTORE = .TRUE.
-END IF
-
-END SUBROUTINE FLYER_CHECK_STORESTEP
-!----------------------------------------------------------------------------
END MODULE MODE_AIRCRAFT_BALLOON_EVOL
diff --git a/ext/default_desfmn.f90 b/ext/default_desfmn.f90
index 9218ccad73d8db5c0d5f36bc6fb81951ca1d8324..33466cf0a528ecca3559fcc0713d498b6249d33e 100644
--- a/ext/default_desfmn.f90
+++ b/ext/default_desfmn.f90
@@ -219,6 +219,7 @@ END MODULE MODI_DEFAULT_DESFM_n
! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation)
! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
! Q. Rodier 07/2021: modify XPOND=1
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
! A. Costes 12/2021: Blaze fire model
! C. Barthe 03/2022: add CIBU and RDSF options in LIMA
! Delbeke/Vie 03/2022: KHKO option in LIMA
@@ -272,6 +273,7 @@ USE MODD_CONDSAMP
USE MODD_MEAN_FIELD
USE MODD_DRAGTREE_n
USE MODD_DRAGBLDG_n
+USE MODD_COUPLING_LEVELS_n
USE MODD_EOL_MAIN
USE MODD_EOL_ADNR
USE MODD_EOL_ALM
@@ -292,6 +294,7 @@ USE MODD_IBM_LSF
USE MODD_FOREFIRE
#endif
USE MODD_FIRE_n
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -302,6 +305,7 @@ INTEGER, INTENT(IN) :: KMI ! Model index
!* 0.2 declaration of local variables
!
INTEGER :: JM ! loop index
+TYPE(TFILEDATA) TFILENAM ! Empty file to satisfy interface of PHYEX_init routines which may calls POSNAM (but do not)
!
!-------------------------------------------------------------------------------
!
@@ -514,14 +518,14 @@ XTNUDGING = 21600.
!* 10. SET DEFAULT VALUES FOR MODD_TURB_n :
! ----------------------------------
!
-CALL TURBN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+CALL TURBN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
!-------------------------------------------------------------------------------
!
!* 10a. SET DEFAULT VALUES FOR MODD_NEB_n :
! ----------------------------------
!
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+CALL NEBN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
!-------------------------------------------------------------------------------
!
@@ -533,6 +537,19 @@ LDEPOTREE = .FALSE.
XVDEPOTREE = 0.02 ! 2 cm/s
!------------------------------------------------------------------------------
!
+!* 10b. SET DEFAULT VALUES FOR MODD_DRAGBLDG_n :
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
+LFLUXBLDG = .FALSE.
+LDRAGURBVEG = .FALSE.
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_COUPLING_LEVELS_n :
+! ----------------------------------
+!
+NLEV_COUPLE = 1
+!------------------------------------------------------------------------------
+!
!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB
! ----------------------------------
!
@@ -577,7 +594,7 @@ XLAT_PROF(:) = XUNDEF
XLON_PROF(:) = XUNDEF
CNAME_PROF(:) = ''
CFILE_PROF = 'NO_INPUT_CSV'
-! LDIAG_SURFRAD = .TRUE.
+LDIAG_SURFRAD_PROF = .TRUE.
!------------------------------------------------------------------------------
!* 10.f SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
! ----------------------------------
@@ -591,7 +608,7 @@ XLAT_STAT(:) = XUNDEF
XLON_STAT(:) = XUNDEF
CNAME_STAT(:) = ''
CFILE_STAT = 'NO_INPUT_CSV'
-LDIAG_SURFRAD = .TRUE.
+LDIAG_SURFRAD_STAT = .TRUE.
!
!-------------------------------------------------------------------------------
!
@@ -828,7 +845,7 @@ END IF
!* 16. SET DEFAULT VALUES FOR MODD_PARAM_ICE :
! ---------------------------------------
!
-CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+CALL PARAM_ICEN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
!
!-------------------------------------------------------------------------------
@@ -854,7 +871,7 @@ NENSM = 0
!* 18. SET DEFAULT VALUES FOR MODD_PARAM_MFSHALL_n :
! --------------------------------------------
!
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
!
!-------------------------------------------------------------------------------
@@ -900,7 +917,7 @@ ENDIF
! ----------------------------------------
!
IF (KMI == 1) THEN
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
+ CALL PARAM_LIMA_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
ENDIF
!
@@ -919,7 +936,7 @@ LCH_PH = .FALSE.
LCH_RET_ICE = .FALSE.
XCH_PHINIT = 5.2
XRTMIN_AQ = 5.e-8
-CCHEM_INPUT_FILE = 'EXSEG1.nam'
+CCHEM_INPUT_FILE = 'MNHC.input'
CCH_TDISCRETIZATION = 'SPLIT'
NCH_SUBSTEPS = 1
LCH_TUV_ONLINE = .FALSE.
@@ -987,8 +1004,8 @@ LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous
! production
LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation
LAERINIT = .FALSE. ! switch to initialize aerosol in arome
-CMINERAL = "NONE" ! mineral equilibrium scheme
-CORGANIC = "NONE" ! mineral equilibrium scheme
+CMINERAL = "EQSAM" ! mineral equilibrium scheme
+CORGANIC = "MPMPO" ! mineral equilibrium scheme
CNUCLEATION = "NONE" ! sulfates nucleation scheme
LDEPOS_AER(:) = .FALSE.
diff --git a/ext/goto_model_wrapper.f90 b/ext/goto_model_wrapper.f90
index b09f1e3fd7c811b0676753fb95e6c8129548fb87..e869230e24429a0a260fcba70bceade88bb9ea62 100644
--- a/ext/goto_model_wrapper.f90
+++ b/ext/goto_model_wrapper.f90
@@ -18,6 +18,7 @@
! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
! F. Auguste 02/21: add IBM
! T. Nagel 02/21: add turbulence recycling
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
! P. Wautelet 27/04/2022: add namelist for profilers
! P. Wautelet 10/02/2023: add Blaze variables
!-----------------------------------------------------------------
@@ -64,6 +65,7 @@ USE MODD_DIM_n
USE MODD_DRAG_n
USE MODD_DRAGTREE_n
USE MODD_DRAGBLDG_n
+USE MODD_COUPLING_LEVELS_n
USE MODD_DUMMY_GR_FIELD_n
USE MODD_DYN_n
USE MODD_DYNZD_n
@@ -163,6 +165,7 @@ CALL CURVCOR_GOTO_MODEL(KFROM, KTO)
CALL DIM_GOTO_MODEL(KFROM, KTO)
CALL DRAGTREE_GOTO_MODEL(KFROM, KTO)
CALL DRAGBLDG_GOTO_MODEL(KFROM, KTO)
+CALL COUPLING_MULT_GOTO_MODEL(KFROM, KTO)
CALL DUMMY_GR_FIELD_GOTO_MODEL(KFROM, KTO)
CALL DYN_GOTO_MODEL(KFROM, KTO)
CALL DYNZD_GOTO_MODEL(KFROM,KTO)
diff --git a/ext/ground_paramn.f90 b/ext/ground_paramn.f90
index 39b041f029d5530d188328c3dd9ae9518ba2271d..598dcdeec67df2619ef469760a903376eaadd98a 100644
--- a/ext/ground_paramn.f90
+++ b/ext/ground_paramn.f90
@@ -9,10 +9,12 @@ MODULE MODI_GROUND_PARAM_n
!
INTERFACE
!
- SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
+ SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFTH_WALL, PSFTH_ROOF, PCD_ROOF, PSFRV, PSFRV_WALL, &
+ PSFRV_ROOF, PSFSV, PSFCO2, PSFU, PSFV, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSRAD, KTCOUNT, TPFILE )
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
!* surface fluxes
! --------------
!
@@ -20,8 +22,13 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_IO, ONLY: TFILEDATA
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! Total surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_WALL ! Wall surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_ROOF ! Roof surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCD_ROOF ! Drag coefficient for roofs (-)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! Total surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_WALL ! Wall surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_ROOF ! Roof surface flux of water vapor (m/s*kg/kg)
REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
! flux of chemical var. (ppv.m/s)
REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg)
@@ -44,9 +51,11 @@ END INTERFACE
!
END MODULE MODI_GROUND_PARAM_n
!
- SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
-! ###############################################################################
+! ######################################################################
+ SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFTH_WALL, PSFTH_ROOF, PCD_ROOF, PSFRV, &
+ PSFRV_WALL, PSFRV_ROOF, PSFSV, PSFCO2, PSFU, &
+ PSFV, PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
+! #######################################################################
!
!
!!**** *GROUND_PARAM*
@@ -117,6 +126,7 @@ END MODULE MODI_GROUND_PARAM_n
!! (V. Vionnet) 18/07/2017 add coupling for blowing snow module
!! (Bielli S.) 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
! A. Costes 12/2021: Blaze Fire model
! P. Wautelet 09/02/2022: bugfix: add missing XCURRENT_LEI computation
! P. Wautelet 30/09/2022: bugfix: missing communications for SWDIFF, SWDIR and LEI
@@ -127,103 +137,108 @@ END MODULE MODI_GROUND_PARAM_n
!* 0. DECLARATIONS
! ------------
!
-!
+USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
+USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD_STAT
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_BLOWSNOW, ONLY: LBLOWSNOW, NBLOWSNOW_2D, YPBLOWSNOW_2D
+USE MODD_BLOWSNOW_n, ONLY: XRSNWCANOS
+USE MODD_BUDGET, ONLY: LBUDGET_TH, LBUDGET_RV, NBUDGET_RV, NBUDGET_TH, TBUDGETS
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_CH_FLX_n, ONLY: XCHFLX
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM
+USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN, NHALO
+USE MODD_COUPLING_LEVELS_n
+USE MODD_CONF_n, ONLY: NRR
+USE MODD_CST, ONLY: XP00, XCPD, XRD, XRV, XRHOLW, XDAY, XPI, XMD, XAVOGADRO
+USE MODD_CSTS_DUST, ONLY: XMOLARWEIGHT_DUST
+USE MODD_CSTS_SALT, ONLY: XMOLARWEIGHT_SALT
+USE MODD_DEEP_CONVECTION_n, ONLY: XPRCONV, XPRSCONV
+USE MODD_DRAGBLDG_n, ONLY : LFLUXBLDG
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG
+USE MODD_DIAG_IN_RUN
+USE MODD_DIM_n, ONLY: NKMAX
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN_n, ONLY: XTSTEP
+USE MODD_FIELD_n, ONLY: XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS, XRTHS, XRRS
+USE MODD_FIRE_n, ONLY: XLSPHI, XBMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMIGNITION, XFMFUELTYPE, &
+ XFIRETAU, XFLUXPARAMH, XFLUXPARAMW, XFIRERW, XFMASE, XFMAWC, XFMWALKIG, &
+ XFMFLUXHDH, XFMFLUXHDW, XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW, XGRADLSPHIX, &
+ XGRADLSPHIY, XFIREWIND, XFMGRADOROX, XFMGRADOROY
+USE MODD_GRID, ONLY: XLON0, XRPK, XBETA
+USE MODD_GRID_n, ONLY: XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE, XSINSLOPE, XZS
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZZ
+USE MODD_MNH_SURFEX_n, ONLY: YSURF_CUR
+USE MODD_NSV, ONLY: CSV, NSV, NSV_AERBEG, NSV_AEREND, NSV_CHEMBEG, NSV_CHEMEND, NSV_DSTBEG, NSV_DSTEND, &
+ NSV_SLTBEG, NSV_SLTEND, NSV_SNWBEG, NSV_SNWEND
+USE MODD_PARAM_C2R2, ONLY: LSEDC
+USE MODD_PREP_SNOW, ONLY: NIMPUR
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_ICE_n, ONLY: LSEDIC
+USE MODD_PARAM_LIMA, ONLY: MSEDC=>LSEDC
+USE MODD_PARAM_n, ONLY: CDCONV, CCLOUD, CRAD, CTURB
+USE MODD_PRECIP_n, ONLY: XINPRC, XINPRR, XINPRS, XINPRG, XINPRH
+USE MODD_PRECISION, ONLY: MNHTIME
+USE MODD_PROFILER_n, ONLY: LPROFILER
+USE MODD_RADIATIONS_n, ONLY: XFLALWD, XCCO2, XTSIDER, &
+ XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, &
+ XZENITH, XAZIM, XAER, XSWU, XLWU
+USE MODD_REF_n, ONLY: XEXNREF, XRHODREF, XRHODJ
+USE MODD_SALT, ONLY: LSALT
+USE MODD_STATION_n, ONLY: LSTATION
+USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
+USE MODD_TIME, ONLY: TDTSEG
+USE MODD_TIME_n, ONLY: TDTCUR
#ifdef CPLOASIS
-USE MODI_GET_HALO
-USE MODI_MNH_OASIS_RECV
-USE MODI_MNH_OASIS_SEND
-USE MODD_SFX_OASIS, ONLY : LOASIS
-USE MODD_DYN, ONLY : XSEGLEN
-USE MODD_DYN_n, ONLY : DYN_MODEL
+USE MODD_SFX_OASIS, ONLY: LOASIS
+USE MODD_DYN, ONLY: XSEGLEN
+USE MODD_DYN_n, ONLY: DYN_MODEL
#endif
-!
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_BUDGET, ONLY: LBUDGET_TH, LBUDGET_RV, NBUDGET_RV, NBUDGET_TH,TBUDGETS
-USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT, BUDGET_STORE_END
-USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD, XAVOGADRO
-USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_DYN_n, ONLY : XTSTEP
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM
-USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS, XRTHS, XRRS
-USE MODD_FIRE_n, ONLY : XLSPHI, XBMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMIGNITION, XFMFUELTYPE, &
- XFIRETAU, XFLUXPARAMH, XFLUXPARAMW, XFIRERW, XFMASE, XFMAWC, XFMWALKIG, &
- XFMFLUXHDH, XFMFLUXHDW, XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW, XGRADLSPHIX, &
- XGRADLSPHIY, XFIREWIND, XFMGRADOROX, XFMGRADOROY
-USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ
-USE MODD_DIM_n, ONLY : NKMAX
-USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE, XSINSLOPE, XZS
-USE MODD_REF_n, ONLY : XEXNREF, XRHODREF, XRHODJ
-USE MODD_CONF_n, ONLY : NRR
-USE MODD_PARAM_n, ONLY : CDCONV,CCLOUD, CRAD
-USE MODD_PRECIP_n, ONLY : XINPRC, XINPRR, XINPRS, XINPRG, XINPRH
-USE MODD_DEEP_CONVECTION_n, ONLY : XPRCONV, XPRSCONV
-USE MODD_CONF, ONLY : LCARTESIAN, CPROGRAM
-USE MODD_TIME_n, ONLY : TDTCUR
-USE MODD_RADIATIONS_n, ONLY : XFLALWD, XCCO2, XTSIDER, &
- XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, &
- XZENITH, XAZIM, XAER, XSWU, XLWU
-USE MODD_NSV
-USE MODD_GRID, ONLY : XLON0, XRPK, XBETA
-USE MODD_PARAM_ICE_n, ONLY : LSEDIC
-USE MODD_PARAM_C2R2, ONLY : LSEDC
-USE MODD_DIAG_IN_RUN
-USE MODD_DUST, ONLY : LDUST
-USE MODD_SALT, ONLY : LSALT
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-USE MODD_CH_AEROSOL, ONLY : LORILAM
-USE MODD_CSTS_DUST, ONLY : XMOLARWEIGHT_DUST
-USE MODD_CSTS_SALT, ONLY : XMOLARWEIGHT_SALT
-USE MODD_CH_FLX_n, ONLY : XCHFLX
-USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG
-USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
-USE MODD_PRECISION, ONLY: MNHTIME
-!
-USE MODI_NORMAL_INTERPOL
-USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND
-USE MODI_SHUMAN
-USE MODI_MNHGET_SURF_PARAM_n
-USE MODI_COUPLING_SURF_ATM_n
-USE MODI_DIAG_SURF_ATM_n
-USE MODD_MNH_SURFEX_n
-!
-USE MODE_DATETIME
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
#ifdef MNH_FOREFIRE
-!** MODULES FOR FOREFIRE **!
USE MODD_FOREFIRE
USE MODD_FOREFIRE_n
-USE MODI_COUPLING_FOREFIRE_n
#endif
-!
-USE MODD_TIME_n
-USE MODD_TIME
-!
-USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
-!
-USE MODD_FIRE_n
-USE MODD_FIELD
+
+USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT, BUDGET_STORE_END
+USE MODE_DATETIME
USE MODE_FIRE_MODEL
-USE MODD_CONF, ONLY : NVERB, NHALO
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_ll
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_MSG
-USE MODD_IO, ONLY: TFILEDATA
+USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND
+
+USE MODI_COUPLING_SURF_ATM_n
+USE MODI_DIAG_SURF_ATM_n
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_NORMAL_INTERPOL
+USE MODI_SHUMAN
+#ifdef CPLOASIS
+USE MODI_GET_HALO
+USE MODI_MNH_OASIS_RECV
+USE MODI_MNH_OASIS_SEND
+#endif
+#ifdef MNH_FOREFIRE
+USE MODI_COUPLING_FOREFIRE_n
+#endif
!
IMPLICIT NONE
!
-!
-!
!* 0.1 declarations of arguments
!
!* surface fluxes
! --------------
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! Total surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_WALL ! Wall surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_ROOF ! Roof surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCD_ROOF ! Drag coefficient for roofs (-)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! Total surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_WALL ! Wall surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_ROOF ! Roof surface flux of water vapor (m/s*kg/kg)
REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
! flux of chemical var. (ppv.m/s)
REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg)
@@ -256,46 +271,65 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! vapor mixing ratio
!
! suffix 'A' stands for atmospheric variable at first model level
!
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF ! Forcing height
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTA ! Temperature
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRVA ! vapor mixing ratio
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZQA ! humidity (kg/m3)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPA ! Pressure
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPS ! Pressure
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNA ! Exner function
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Exner function
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTHA ! potential temperature
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRAIN ! liquid precipitation (kg/m2/s)
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSNOW ! solid precipitation (kg/m2/s)
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTSUN ! solar time (s since midnight)
-!
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZUA ! u component of the wind
-! ! parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZVA ! v component of the wind
-! ! parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZU ! zonal wind
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZV ! meridian wind
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWIND ! wind parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRHOA ! air density
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZDIR ! wind direction (rad from N clockwise)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFU ! zonal momentum flux
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFV ! meridian momentum flux
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPS ! Surface pressure
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Surface Exner function
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCO2 ! CO2 concentration (kg/kg)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZALFA ! angle between the wind
-! ! and the x axis
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZU2D ! u and v component of the
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZV2D ! wind at mass point
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH ! Turbulent flux of heat
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Turbulent flux of water
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFCO2 ! Turbulent flux of CO2
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NSV):: ZSFTS! Turbulent flux of scalar
!
+! Variables for which multiple levels are sent to SURFEX and related ancilliary variables
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZREF ! Forcing height
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTA ! Temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVA ! vapor mixing ratio
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQA ! humidity (kg/m3)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPA ! Pressure
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNA ! Exner function
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHA ! potential temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUA ! u component of the wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVA ! v component of the wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU ! zonal wind
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV ! meridian wind
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWIND ! wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHOA ! air density
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTKE ! Subgrid turbulent kinetic energy
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR ! wind direction (rad from N clockwise)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZALFA ! angle between the wind and the x axis
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU2D ! u and v component of the
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV2D ! wind at mass point
+!
+! SURFEX output fluxes
+!
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFU ! zonal momentum flux
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFV ! meridian momentum flux
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH ! Total turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_SURF ! Surface turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_WALL ! Wall turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_ROOF ! Roof turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCD_ROOF ! Drag coefficient for roofs
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Total turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_SURF ! Surface turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_WALL ! Wall turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_ROOF ! Roof turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFCO2 ! Turbulent flux of CO2
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NSV):: ZSFTS ! Turbulent flux of scalar
REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NBLOWSNOW_2D) :: ZBLOWSNOW_2D ! 2D blowing snow variables
! after advection
! They refer to the 2D fields advected by MNH including:
! - total number concentration in Canopy
! - total mass concentration in Canopy
! - equivalent concentration in the saltation layer
+
+!
+! Anxiliary variables
+!
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF_DIST
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF_VERT
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWEIGHT_VERT
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLW_ILEV
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLW_ILEVP1
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLSCAL_ILEV
!
!* Dimensions
! ----------
@@ -322,29 +356,44 @@ INTEGER :: KSV_SURF ! Number of scalar variables sent to SURFEX
!* Arrays put in 1D vectors
! ------------------------
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSUN ! solar time
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZREF ! forcing height
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZS ! orography
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_U ! zonal wind
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_V ! meridian wind
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_QA ! air humidity (kg/m3)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TA ! air temperature
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_RHOA ! air density
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level
+! Pure surface variables or variables forced at only one level
+!
REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level
REAL, DIMENSION(:), ALLOCATABLE :: ZP_RAIN ! liquid precipitation
REAL, DIMENSION(:), ALLOCATABLE :: ZP_SNOW ! solid precipitation
REAL, DIMENSION(:), ALLOCATABLE :: ZP_LW ! incoming longwave
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_SW ! direct incoming shortwave
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_SW ! diffuse incoming shortwave
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level
REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZWS ! significant wave height (m)
-
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! water vapor flux
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSUN ! solar time
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZS ! orography
+!
+! Variables that are forced at multiple levels
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZREF ! forcing height
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_U ! zonal wind
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_V ! meridian wind
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_QA ! air humidity (kg/m3)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_TA ! air temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_RHOA ! air density
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_TKE ! Subgrid turbulent kinetic energy
+!
+! SURFEX output variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! Total water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_SURF ! Surface water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_WALL ! Wall water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_ROOF ! Roof water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! Total potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_SURF ! Surface potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_WALL ! Wall potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_ROOF ! Roof potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_CD_ROOF ! Drag coefficient for roofs
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SFTS ! scalar flux
REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFCO2 ! CO2 flux
REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFU ! zonal momentum flux
@@ -353,12 +402,11 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative surface temperature
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_ALB ! direct albedo
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_ALB ! diffuse albedo
REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity
-
REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSURF
REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0
REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0H
REAL, DIMENSION(:), ALLOCATABLE :: ZP_QSURF
-
+!
REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_A_COEF ! coefficients for
REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_B_COEF ! implicit coupling
REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_A_COEF
@@ -375,6 +423,9 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZP_Q2M ! Air humidity at 2 meters
REAL, DIMENSION(:), ALLOCATABLE :: ZP_HU2M ! Air relative humidity at 2 meters (-)
REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZON10M ! zonal Wind at 10 meters (m/s)
REAL, DIMENSION(:), ALLOCATABLE :: ZP_MER10M ! meridian Wind at 10 meters (m/s)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZIMPWET ! wet deposit coefficient for each impurity type (g)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZIMPDRY ! dry deposit coefficient for each impurity type (g)
+
TYPE(LIST_ll), POINTER :: TZFIELDSURF_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
!
@@ -383,8 +434,16 @@ CHARACTER(LEN=6) :: YJSV
CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: YSV_SURF ! name of the scalar variables
! sent to SURFEX
!
-REAL :: ZTIMEC
-INTEGER :: ILUOUT ! logical unit
+LOGICAL :: GSTATPROF_SURF ! TRUE if station or profiler need to write surface or radiation data
+REAL :: ZTIMEC
+INTEGER :: ILUOUT ! logical unit
+!
+! New variables for coupling at several levels
+!
+REAL :: ZAGLW_JK
+REAL :: ZAGLW_JKP1
+REAL :: ZAGLSCAL_JK
+INTEGER :: ICOUNT, ILEV
!
! Fire model
REAL(KIND=MNHTIME), DIMENSION(2) :: ZFIRETIME1, ZFIRETIME2 ! CPU time for Blaze perf profiling
@@ -395,7 +454,7 @@ REAL(KIND=MNHTIME), DIMENSION(2) :: ZROSWINDTIME1, ZROSWINDTIME2 ! CPU
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFIREFUELMAP ! Fuel map
CHARACTER(LEN=7) :: YFUELMAPFILE ! Fuel Map file name
TYPE(LIST_ll), POINTER :: TZFIELDFIRE_ll ! list of fields to exchange
-
+!
!-------------------------------------------------------------------------------
!
!
@@ -406,8 +465,14 @@ IKE=IKU-JPVEXT
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
-PSFTH = XUNDEF_SFX
-PSFRV = XUNDEF_SFX
+PSFTH = XUNDEF_SFX
+PSFTH_WALL = XUNDEF_SFX
+PSFTH_ROOF = XUNDEF_SFX
+PCD_ROOF = XUNDEF_SFX
+PSFRV = XUNDEF_SFX
+PSFRV_WALL = XUNDEF_SFX
+PSFRV_ROOF = XUNDEF_SFX
+!
PSFSV = XUNDEF_SFX
PSFCO2 = XUNDEF_SFX
PSFU = XUNDEF_SFX
@@ -417,6 +482,28 @@ PSCA_ALB = XUNDEF_SFX
PEMIS = XUNDEF_SFX
PTSRAD = XUNDEF_SFX
!
+! Allocation of the local variables
+!
+ALLOCATE(ZZREF(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZTA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZRVA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZQA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZPA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZEXNA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZTHA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZUA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZVA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZU(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZV(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZWIND(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZRHOA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+IF(CTURB/='NONE') ALLOCATE(ZTKE(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZDIR(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZALFA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZU2D(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZV2D(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+!
+GSTATPROF_SURF = ( LPROFILER .AND. LDIAG_SURFRAD_PROF ) .OR. ( LSTATION .AND. LDIAG_SURFRAD_STAT )
!
!-------------------------------------------------------------------------------
!
@@ -438,51 +525,78 @@ END IF
! 1.2 Horizontal wind direction (rad from N clockwise)
! -------------------------
!
-ZU2D(:,:,:)=MXF(XUT(:,:,IKB:IKB))
-ZV2D(:,:,:)=MYF(XVT(:,:,IKB:IKB))
+ZU2D(:,:,:)=MXF(XUT(:,:,IKB:(IKB+NLEV_COUPLE-1)))
+ZV2D(:,:,:)=MYF(XVT(:,:,IKB:(IKB+NLEV_COUPLE-1)))
!
!* angle between Y axis and wind (rad., clockwise)
!
ZALFA = 0.
-WHERE(ZU2D(:,:,1)/=0. .OR. ZV2D(:,:,1)/=0.)
- ZALFA(:,:)=ATAN2(ZU2D(:,:,1),ZV2D(:,:,1))
-END WHERE
-WHERE(ZALFA(:,:)<0.) ZALFA(:,:) = ZALFA(:,:) + 2. * XPI
-!
-!* angle between North and wind (rad., clockwise)
!
-IF (.NOT. LCARTESIAN) THEN
- ZDIR = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA
+DO ILEV=1,NLEV_COUPLE
+ !
+ WHERE(ZU2D(:,:,ILEV)/=0. .OR. ZV2D(:,:,ILEV)/=0.)
+ ZALFA(:,:,ILEV)=ATAN2(ZU2D(:,:,ILEV),ZV2D(:,:,ILEV))
+ END WHERE
+ !
+ WHERE(ZALFA(:,:,ILEV)<0.) ZALFA(:,:,ILEV) = ZALFA(:,:,ILEV) + 2. * XPI
+ !
+ !* angle between North and wind (rad., clockwise)
+ !
+ IF (.NOT. LCARTESIAN) THEN
+ ZDIR(:,:,ILEV) = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA(:,:,ILEV)
+ ELSE
+ ZDIR(:,:,ILEV) = - XBETA * XPI/180. + ZALFA(:,:,ILEV)
+ ENDIF
+ !
+ ! 1.3 Rotate the wind
+ ! Only for the first forcing level, used for friction force direction.
+ ! ---------------
+ !
+ IF (ILEV.EQ.1) THEN
+ !
+ CALL ROTATE_WIND(D,XUT,XVT,XWT, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE,XSINSLOPE, &
+ XDXX,XDYY,XDZZ, &
+ ZUA(:,:,ILEV),ZVA(:,:,ILEV) )
+ !
+ ELSE
+ !
+ ZUA(:,:,ILEV) = XUT(:,:,IKB+ILEV-1)
+ ZVA(:,:,ILEV) = XVT(:,:,IKB+ILEV-1)
+ !
+ ENDIF
+ !
+ ! 1.4 zonal and meridian components of the wind parallel to the slope
+ ! ---------------------------------------------------------------
+ !
+ ZWIND(:,:,ILEV) = SQRT( ZUA(:,:,ILEV)**2 + ZVA(:,:,ILEV)**2 )
+ !
+ ZU(:,:,ILEV) = ZWIND(:,:,ILEV) * SIN(ZDIR(:,:,ILEV))
+ ZV(:,:,ILEV) = ZWIND(:,:,ILEV) * COS(ZDIR(:,:,ILEV))
+ !
+ENDDO
+ !
+ ! 1.5 Horizontal interpolation of the thermodynamic fields
+ ! -------------------------------------------------
+ !
+ ! This horizontal interpolation is only made if the forcing is located at the first level
+ !
+IF (NLEV_COUPLE.EQ.1) THEN
+ !
+ CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE,XSINSLOPE, &
+ XDXX,XDYY,XDZZ, &
+ ZTHA(:,:,1),ZRVA(:,:,1),ZEXNA(:,:,1) )
+ !
ELSE
- ZDIR = - XBETA * XPI/180. + ZALFA
-END IF
-!
-!
-! 1.3 Rotate the wind
-! ---------------
-!
-CALL ROTATE_WIND( D, XUT, XVT, XWT, &
- XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE, XSINSLOPE, &
- XDXX, XDYY, XDZZ, &
- ZUA, ZVA )
-!
-! 1.4 zonal and meridian components of the wind parallel to the slope
-! ---------------------------------------------------------------
-!
-ZWIND(:,:) = SQRT( ZUA**2 + ZVA**2 )
-!
-ZU(:,:) = ZWIND(:,:) * SIN(ZDIR)
-ZV(:,:) = ZWIND(:,:) * COS(ZDIR)
-!
-! 1.5 Horizontal interpolation the thermodynamic fields
-! -------------------------------------------------
-!
-CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, &
- XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE,XSINSLOPE, &
- XDXX,XDYY,XDZZ, &
- ZTHA,ZRVA,ZEXNA )
+ !
+ ZEXNA (:,:,1:NLEV_COUPLE) = (XPABST(:,:,IKB:(IKB+NLEV_COUPLE-1))/XP00) ** (XRD/XCPD)
+ ZTHA (:,:,1:NLEV_COUPLE) = XTHT(:,:,IKB:(IKB+NLEV_COUPLE-1))
+ ZRVA (:,:,1:NLEV_COUPLE) = ZRV (:,:,IKB:(IKB+NLEV_COUPLE-1))
+ !
+ENDIF
!
DEALLOCATE(ZRV)
!
@@ -490,8 +604,7 @@ DEALLOCATE(ZRV)
! 1.6 Pressure and Exner function
! ---------------------------
!
-!
-ZPA(:,:) = XP00 * ZEXNA(:,:) **(XCPD/XRD)
+ZPA(:,:,:) = XP00 * ZEXNA(:,:,:) ** (XCPD/XRD)
!
ZEXNS(:,:) = 0.5 * ( (XPABST(:,:,IKB-1)/XP00)**(XRD/XCPD) &
+(XPABST(:,:,IKB )/XP00)**(XRD/XCPD) &
@@ -501,23 +614,22 @@ ZPS(:,:) = XP00 * ZEXNS(:,:) **(XCPD/XRD)
! 1.7 humidity in kg/m3 from the mixing ratio
! ---------------------------------------
!
-!
-ZQA(:,:) = ZRVA(:,:) * XRHODREF(:,:,IKB)
-!
+ZQA(:,:,:) = ZRVA(:,:,:) * XRHODREF(:,:,IKB:(IKB+NLEV_COUPLE-1))
!
! 1.8 Temperature from the potential temperature
! ------------------------------------------
!
-!
-ZTA(:,:) = ZTHA(:,:) * ZEXNA(:,:)
-!
+ZTA(:,:,:) = ZTHA(:,:,:) * ZEXNA(:,:,:)
!
! 1.9 Air density
! -----------
!
-ZRHOA(:,:) = ZPA(:,:)/(XRD * ZTA(:,:) * ((1. + (XRD/XRV)*ZRVA(:,:))/ &
- (1. + ZRVA(:,:))))
+ZRHOA(:,:,:) = ZPA(:,:,:)/(XRD * ZTA(:,:,:) * &
+ ((1. + (XRD/XRV)*ZRVA(:,:,:)) / (1. + ZRVA(:,:,:))))
!
+! Subgrid turbulent kinetic energy
+!
+IF(CTURB/='NONE') ZTKE(:,:,:) = XTKET(:,:,IKB:(IKB+NLEV_COUPLE-1))
!
! 1.10 Precipitations
! --------------
@@ -554,8 +666,39 @@ END IF
! 1.12 Forcing level
! -------------
!
-ZZREF(:,:) = 0.5*( XZZ(:,:,IKB+1)-XZZ(:,:,IKB) )*XDIRCOSZW(:,:)
-!
+! A smooth transition between vertical height above ground and
+! distance to the surface is implemented here.
+! We assume that for katabatic winds located in the first meters above
+! ground, the distance to the surface is the most relevant whereas
+! for most other processes it will be the vertical distance to the surface
+!
+DO ILEV=1,NLEV_COUPLE
+ !
+ ! Height above ground of w-levels
+ !
+ ZAGLW_ILEV (:,:) = XZZ(:,:,JPVEXT+ILEV ) - XZZ(:,:,1+JPVEXT)
+ ZAGLW_ILEVP1 (:,:) = XZZ(:,:,JPVEXT+ILEV+1) - XZZ(:,:,1+JPVEXT)
+ !
+ ! Height above ground of scalar variables and (u,v)
+ !
+ ZAGLSCAL_ILEV(:,:) = 0.5 * ( ZAGLW_ILEV(:,:) + ZAGLW_ILEVP1(:,:) )
+ !
+ ! Distance to the inclined surface and vertical distance
+ !
+ ZZREF_DIST(:,:) = ZAGLSCAL_ILEV(:,:) * XDIRCOSZW(:,:)
+ !
+ ZZREF_VERT(:,:) = ZAGLSCAL_ILEV(:,:)
+ !
+ ! Scaling between 5 m and 20 m height
+ !
+ ZWEIGHT_VERT(:,:) = MIN(1.0,MAX(ZZREF_VERT(:,:)-5.0,0.0)/15.0)
+ !
+ IF (MAXVAL(ZWEIGHT_VERT).GT.1.0) STOP ("Wrong weight")
+ IF (MINVAL(ZWEIGHT_VERT).LT.0.0) STOP ("Wrong weight")
+ !
+ ZZREF(:,:,ILEV) = ZWEIGHT_VERT(:,:) * ZZREF_VERT(:,:) + (1.0 - ZWEIGHT_VERT(:,:)) * ZZREF_DIST(:,:)
+ !
+ENDDO
!
! 1.13 CO2 concentration (kg/m3)
! -----------------
@@ -592,6 +735,7 @@ ELSE
YSV_SURF(:) = CSV(1:NSV)
ENDIF
!
+!
!-------------------------------------------------------------------------------
!
!* 2. Call to surface monitor with 2D variables
@@ -630,18 +774,19 @@ END IF
#endif
!
! Call to surface schemes
-!
-CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, &
- XTSTEP, TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
- IDIM1D,KSV_SURF,SIZE(XSW_BANDS), &
- ZP_TSUN, ZP_ZENITH,ZP_ZENITH, ZP_AZIM, &
- ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, YSV_SURF, &
- ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, ZP_PS, ZP_PA, &
- ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
- ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF,ZP_ZWS, &
- 'OK' )
+!
+CALL COUPLING_SURF_ATM_MULTI_LEVEL_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, XTSTEP, &
+ TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
+ IDIM1D,KSV_SURF,SIZE(XSW_BANDS), NLEV_COUPLE, ZP_TSUN, ZP_ZENITH,ZP_ZENITH, &
+ ZP_AZIM, ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, &
+ ZP_CO2, ZP_ZIMPWET, ZP_ZIMPDRY, YSV_SURF, &
+ ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_TKE, ZP_SFTQ, ZP_SFTQ_SURF, ZP_SFTQ_WALL, ZP_SFTQ_ROOF, &
+ ZP_SFTH, ZP_SFTH_SURF, ZP_SFTH_WALL, ZP_SFTH_ROOF, ZP_CD_ROOF, ZP_SFTS, &
+ ZP_SFCO2, ZP_SFU, ZP_SFV, ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, &
+ ZP_Z0, ZP_Z0H, ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, &
+ ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, ZP_ZWS, 'OK' )
+
!
#ifdef CPLOASIS
IF (LOASIS) THEN
@@ -657,11 +802,15 @@ IF (LOASIS) THEN
END IF
#endif
!
-IF (CPROGRAM=='DIAG ' .OR. LDIAG_IN_RUN) THEN
- CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
- CALL MNHGET_SURF_PARAM_n( PRN = ZP_RN, PH = ZP_H, PLE = ZP_LE, PLEI = ZP_LEI, &
- PGFLUX = ZP_GFLUX, PT2M = ZP_T2M, PQ2M = ZP_Q2M, PHU2M = ZP_HU2M, &
- PZON10M = ZP_ZON10M, PMER10M = ZP_MER10M )
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ CALL DIAG_SURF_ATM_n( YSURF_CUR, 'MESONH' )
+ IF ( CPROGRAM == 'DIAG' ) THEN
+ CALL MNHGET_SURF_PARAM_n(PZON10M=ZP_ZON10M, PMER10M=ZP_MER10M)
+ ELSE
+ CALL MNHGET_SURF_PARAM_n( PRN=ZP_RN, PH=ZP_H, PLE=ZP_LE, PLEI=ZP_LEI, &
+ PGFLUX=ZP_GFLUX, PT2M=ZP_T2M, PQ2M=ZP_Q2M, PHU2M=ZP_HU2M, &
+ PZON10M=ZP_ZON10M, PMER10M=ZP_MER10M)
+ END IF
END IF
!
! Transform 1D output fields into 2D:
@@ -671,7 +820,7 @@ CALL UNSHAPE_SURF(IDIM1,IDIM2)
!------------------------!
! COUPLING WITH FOREFIRE !
!------------------------!
-
+
IF ( LFOREFIRE ) THEN
CALL FOREFIRE_DUMP_FIELDS_n(XUT, XVT, XWT, XSVT&
, XTHT, XRT(:,:,:,1), XPABST, XTKET&
@@ -695,15 +844,16 @@ FF_TIME = FF_TIME + XTSTEP
!
! Friction of components along slope axes (U: largest local slope axis, V: zero slope axis)
!
-!
PSFU(:,:) = 0.
PSFV(:,:) = 0.
!
-WHERE (ZSFU(:,:)/=XUNDEF_SFX .AND. ZWIND(:,:)>0.)
- PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
- PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
+WHERE (ZSFU(:,:)/=XUNDEF_SFX .AND. ZWIND(:,:,1)>0.)
+ PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:,1) / ZWIND(:,:,1) / XRHODREF(:,:,IKB)
+ PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:,1) / ZWIND(:,:,1) / XRHODREF(:,:,IKB)
END WHERE
!
+PCD_ROOF(:,:) = ZCD_ROOF(:,:)
+!
!* 2.1 Blaze Fire Model
! ----------------
@@ -862,13 +1012,49 @@ IF (LBLAZE) THEN
END IF
!* conversion from H (W/m2) to w'Theta'
!
-PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB)
-!
-!
-!* conversion from water flux (kg/m2/s) to w'rv'
-!
-PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB)
-!
+! Unit conversions:
+!
+!* H: (W/m2) to w'Theta'
+!
+!* Water flux: (kg/m2/s) to w'rv'
+!
+IF (LFLUXBLDG) THEN
+ !
+ ! Robert: Here the wall and roof fluxes are substracted from the surface fluxes
+ ! since they will be applied in drag_bld.F90
+ !
+ PSFTH(:,:) = ( ZSFTH(:,:) - ZSFTH_WALL(:,:) - ZSFTH_ROOF(:,:) ) / XCPD / XRHODREF(:,:,IKB)
+ PSFRV(:,:) = ( ZSFTQ(:,:) - ZSFTQ_WALL(:,:) - ZSFTQ_ROOF(:,:) ) / XRHODREF(:,:,IKB)
+ !
+ ! Wall and roof fluxes are written on separate variables
+ !
+ PSFTH_WALL(:,:) = ZSFTH_WALL(:,:) / XCPD / XRHODREF(:,:,IKB)
+ PSFTH_ROOF(:,:) = ZSFTH_ROOF(:,:) / XCPD / XRHODREF(:,:,IKB)
+ !
+ PSFRV_WALL(:,:) = ZSFTQ_WALL(:,:) / XRHODREF(:,:,IKB)
+ PSFRV_ROOF(:,:) = ZSFTQ_ROOF(:,:) / XRHODREF(:,:,IKB)
+ !
+ ! Test conservation of fluxes
+ !
+ IF (MAXVAL(ABS(ZSFTH(:,:)/XCPD/XRHODREF(:,:,IKB) - PSFTH(:,:) - PSFTH_WALL(:,:)&
+ - PSFTH_ROOF(:,:))).GT.1.0E-6) STOP ("Wrong H flux partition")
+ IF (MAXVAL(ABS(ZSFTQ(:,:)/XRHODREF(:,:,IKB) - PSFRV(:,:) - PSFRV_WALL(:,:)&
+ - PSFRV_ROOF(:,:))).GT.1.0E-6) STOP ("Wrong Q flux partition")
+ !
+ELSE
+ !
+ ! Otherwise the full surface fluxes are taken
+ !
+ PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB)
+ PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB)
+ !
+ PSFTH_WALL(:,:) = 0.0
+ PSFTH_ROOF(:,:) = 0.0
+ !
+ PSFRV_WALL(:,:) = 0.0
+ PSFRV_ROOF(:,:) = 0.0
+ !
+ENDIF
!
!* conversion from scalar flux (kg/m2/s) to w'rsv'
!
@@ -923,11 +1109,11 @@ END IF
!
IF (LBLOWSNOW) THEN
DO JSV=NSV_SNWBEG,NSV_SNWEND
- PSFSV(:,:,JSV) = ZSFTS(:,:,JSV)/ (ZRHOA(:,:))
+ PSFSV(:,:,JSV) = ZSFTS(:,:,JSV)/ (ZRHOA(:,:,1))
END DO
!* Update tendency for blowing snow 2D fields
DO JSV=1,(NBLOWSNOW_2D)
- XRSNWCANOS(:,:,JSV) = ZBLOWSNOW_2D(:,:,JSV)*XRHODJ(:,:,IKB)/(XTSTEP*ZRHOA(:,:))
+ XRSNWCANOS(:,:,JSV) = ZBLOWSNOW_2D(:,:,JSV)*XRHODJ(:,:,IKB)/(XTSTEP*ZRHOA(:,:,1))
END DO
ELSE
@@ -969,53 +1155,61 @@ CALL CLEANLIST_ll(TZFIELDSURF_ll)
! -----------
!
!
-IF (LDIAG_IN_RUN) THEN
- !
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
XCURRENT_SFCO2(:,:) = ZSFCO2(:,:)
- XCURRENT_DSTAOD(:,:)=0.0
- XCURRENT_SLTAOD(:,:)=0.0
- IF (CRAD/='NONE') THEN
- XCURRENT_LWD (:,:) = XFLALWD(:,:)
- XCURRENT_SWD (:,:) = SUM(XDIRSRFSWD(:,:,:)+XSCAFLASWD(:,:,:),DIM=3)
- XCURRENT_LWU (:,:) = XLWU(:,:,IKB)
- XCURRENT_SWU (:,:) = XSWU(:,:,IKB)
- XCURRENT_SWDIR(:,:) = SUM(XDIRSRFSWD,DIM=3)
- XCURRENT_SWDIFF(:,:) = SUM(XSCAFLASWD(:,:,:),DIM=3)
- DO JK=IKB,IKE
- IKRAD = JK - 1
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- XCURRENT_DSTAOD(JI,JJ)=XCURRENT_DSTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,3)
- XCURRENT_SLTAOD(JI,JJ)=XCURRENT_SLTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,2)
- ENDDO
- ENDDO
- ENDDO
+ IF ( CRAD /= 'NONE' ) THEN
+ XCURRENT_LWD (:,:) = XFLALWD(:,:)
+ XCURRENT_SWD (:,:) = SUM( XDIRSRFSWD(:,:,:) + XSCAFLASWD(:,:,:), DIM=3 )
+ XCURRENT_LWU (:,:) = XLWU(:,:,IKB)
+ XCURRENT_SWU (:,:) = XSWU(:,:,IKB)
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ XCURRENT_SWDIR(:,:) = SUM( XDIRSRFSWD(:,:,:), DIM=3 )
+ XCURRENT_SWDIFF(:,:) = SUM( XSCAFLASWD(:,:,:), DIM=3 )
+ XCURRENT_DSTAOD(:,:) = 0.0
+ XCURRENT_SLTAOD(:,:) = 0.0
+ DO JK=IKB,IKE
+ IKRAD = JK - 1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ XCURRENT_DSTAOD(JI,JJ) = XCURRENT_DSTAOD(JI,JJ) + XAER(JI,JJ,IKRAD,3)
+ XCURRENT_SLTAOD(JI,JJ) = XCURRENT_SLTAOD(JI,JJ) + XAER(JI,JJ,IKRAD,2)
+ END DO
+ END DO
+ END DO
+ END IF
END IF
-!
NULLIFY(TZFIELDSURF_ll)
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_RN, 'GROUND_PARAM_n::XCURRENT_RN' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_H, 'GROUND_PARAM_n::XCURRENT_H' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LE, 'GROUND_PARAM_n::XCURRENT_LE' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LEI, 'GROUND_PARAM_n::XCURRENT_LEI' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_GFLUX, 'GROUND_PARAM_n::XCURRENT_GFLUX' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWD, 'GROUND_PARAM_n::XCURRENT_LWD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIR, 'GROUND_PARAM_n::XCURRENT_SWDIR' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIFF, 'GROUND_PARAM_n::XCURRENT_SWDIFF' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_T2M, 'GROUND_PARAM_n::XCURRENT_T2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_Q2M, 'GROUND_PARAM_n::XCURRENT_Q2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_HU2M, 'GROUND_PARAM_n::XCURRENT_HU2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SLTAOD, 'GROUND_PARAM_n::XCURRENT_SLTAOD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZWS, 'GROUND_PARAM_n::XCURRENT_ZWS' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SFCO2, 'GROUND_PARAM_n::XCURRENT_SFCO2' )
+
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SFCO2, 'GROUND_PARAM_n::XCURRENT_SFCO2' )
+ IF ( CRAD /= 'NONE' ) THEN
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWD, 'GROUND_PARAM_n::XCURRENT_LWD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' )
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIR, 'GROUND_PARAM_n::XCURRENT_SWDIR' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIFF, 'GROUND_PARAM_n::XCURRENT_SWDIFF' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SLTAOD, 'GROUND_PARAM_n::XCURRENT_SLTAOD' )
+ END IF
+ END IF
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' )
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_RN, 'GROUND_PARAM_n::XCURRENT_RN' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_H, 'GROUND_PARAM_n::XCURRENT_H' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LE, 'GROUND_PARAM_n::XCURRENT_LE' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LEI, 'GROUND_PARAM_n::XCURRENT_LEI' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_GFLUX, 'GROUND_PARAM_n::XCURRENT_GFLUX' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_T2M, 'GROUND_PARAM_n::XCURRENT_T2M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_Q2M, 'GROUND_PARAM_n::XCURRENT_Q2M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_HU2M, 'GROUND_PARAM_n::XCURRENT_HU2M' )
+ END IF
+ ! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZWS, 'GROUND_PARAM_n::XCURRENT_ZWS' )
CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDSURF_ll)
+ !
END IF
!
IF (LBLAZE) THEN
@@ -1037,16 +1231,23 @@ INTEGER, DIMENSION(1) :: ISHAPE_1
!
ISHAPE_1 = (/KDIM1D/)
!
+! Variables that are coupled at multiple levels
+!
+ALLOCATE(ZP_ZREF (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_U (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_V (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_QA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_TA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_PA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_RHOA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_TKE (KDIM1D,NLEV_COUPLE))
+!
+! 2D Variables and variables that are coupled at the surface only
+!
ALLOCATE(ZP_TSUN (KDIM1D))
ALLOCATE(ZP_ZENITH (KDIM1D))
ALLOCATE(ZP_AZIM (KDIM1D))
-ALLOCATE(ZP_ZREF (KDIM1D))
ALLOCATE(ZP_ZS (KDIM1D))
-ALLOCATE(ZP_U (KDIM1D))
-ALLOCATE(ZP_V (KDIM1D))
-ALLOCATE(ZP_QA (KDIM1D))
-ALLOCATE(ZP_TA (KDIM1D))
-ALLOCATE(ZP_RHOA (KDIM1D))
ALLOCATE(ZP_SV (KDIM1D,KSV_SURF))
ALLOCATE(ZP_CO2 (KDIM1D))
ALLOCATE(ZP_RAIN (KDIM1D))
@@ -1055,11 +1256,19 @@ ALLOCATE(ZP_LW (KDIM1D))
ALLOCATE(ZP_DIR_SW (KDIM1D,SIZE(XDIRSRFSWD,3)))
ALLOCATE(ZP_SCA_SW (KDIM1D,SIZE(XSCAFLASWD,3)))
ALLOCATE(ZP_PS (KDIM1D))
-ALLOCATE(ZP_PA (KDIM1D))
ALLOCATE(ZP_ZWS (KDIM1D))
-
-ALLOCATE(ZP_SFTQ (KDIM1D))
-ALLOCATE(ZP_SFTH (KDIM1D))
+!
+! 2D SURFEX output fields
+!
+ALLOCATE(ZP_SFTQ (KDIM1D))
+ALLOCATE(ZP_SFTQ_SURF (KDIM1D))
+ALLOCATE(ZP_SFTQ_WALL (KDIM1D))
+ALLOCATE(ZP_SFTQ_ROOF (KDIM1D))
+ALLOCATE(ZP_SFTH (KDIM1D))
+ALLOCATE(ZP_SFTH_SURF (KDIM1D))
+ALLOCATE(ZP_SFTH_WALL (KDIM1D))
+ALLOCATE(ZP_SFTH_ROOF (KDIM1D))
+ALLOCATE(ZP_CD_ROOF (KDIM1D))
ALLOCATE(ZP_SFU (KDIM1D))
ALLOCATE(ZP_SFV (KDIM1D))
ALLOCATE(ZP_SFTS (KDIM1D,KSV_SURF))
@@ -1072,17 +1281,21 @@ ALLOCATE(ZP_TSURF (KDIM1D))
ALLOCATE(ZP_Z0 (KDIM1D))
ALLOCATE(ZP_Z0H (KDIM1D))
ALLOCATE(ZP_QSURF (KDIM1D))
-ALLOCATE(ZP_RN (KDIM1D))
-ALLOCATE(ZP_H (KDIM1D))
-ALLOCATE(ZP_LE (KDIM1D))
-ALLOCATE(ZP_LEI (KDIM1D))
-ALLOCATE(ZP_GFLUX (KDIM1D))
-ALLOCATE(ZP_T2M (KDIM1D))
-ALLOCATE(ZP_Q2M (KDIM1D))
-ALLOCATE(ZP_HU2M (KDIM1D))
-ALLOCATE(ZP_ZON10M (KDIM1D))
-ALLOCATE(ZP_MER10M (KDIM1D))
-
+IF ( GSTATPROF_SURF ) THEN
+ ALLOCATE(ZP_RN (KDIM1D))
+ ALLOCATE(ZP_H (KDIM1D))
+ ALLOCATE(ZP_LE (KDIM1D))
+ ALLOCATE(ZP_LEI (KDIM1D))
+ ALLOCATE(ZP_GFLUX (KDIM1D))
+ ALLOCATE(ZP_T2M (KDIM1D))
+ ALLOCATE(ZP_Q2M (KDIM1D))
+ ALLOCATE(ZP_HU2M (KDIM1D))
+END IF
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ ALLOCATE(ZP_ZON10M (KDIM1D))
+ ALLOCATE(ZP_MER10M (KDIM1D))
+END IF
+!
!* explicit coupling only
ALLOCATE(ZP_PEW_A_COEF (KDIM1D))
ALLOCATE(ZP_PEW_B_COEF (KDIM1D))
@@ -1090,22 +1303,30 @@ ALLOCATE(ZP_PET_A_COEF (KDIM1D))
ALLOCATE(ZP_PEQ_A_COEF (KDIM1D))
ALLOCATE(ZP_PET_B_COEF (KDIM1D))
ALLOCATE(ZP_PEQ_B_COEF (KDIM1D))
-
-ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_TA(:) = RESHAPE(ZTA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_QA(:) = RESHAPE(ZQA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_RHOA(:) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_U(:) = RESHAPE(ZU(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_V(:) = RESHAPE(ZV(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_PS(:) = RESHAPE(ZPS(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_PA(:) = RESHAPE(ZPA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZS(:) = RESHAPE(XZS(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZREF(:) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1)
-
+!
+! 2D variables or surface only
+!
+ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_PS(:) = RESHAPE(ZPS(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_ZS(:) = RESHAPE(XZS(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1)
+!
+! Variables that are coupled on multiple levels
+!
+DO JLAYER=1,NLEV_COUPLE
+ ZP_ZREF(:,JLAYER) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_PA(:,JLAYER) = RESHAPE(ZPA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_TA(:,JLAYER) = RESHAPE(ZTA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_QA(:,JLAYER) = RESHAPE(ZQA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_RHOA(:,JLAYER) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ IF(CTURB/='NONE') ZP_TKE(:,JLAYER) = RESHAPE(ZTKE(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_U(:,JLAYER) = RESHAPE(ZU(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_V(:,JLAYER) = RESHAPE(ZV(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+END DO
+!
DO JLAYER=1,NSV
ZP_SV(:,JLAYER) = RESHAPE(XSVT(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1)
END DO
@@ -1118,29 +1339,29 @@ END IF
!
!chemical conversion : from part/part to molec./m3
DO JLAYER=NSV_CHEMBEG,NSV_CHEMEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:,1) / XMD
END DO
DO JLAYER=NSV_AERBEG,NSV_AEREND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:,1) / XMD
END DO
!dust conversion : from part/part to kg/m3
DO JLAYER=NSV_DSTBEG,NSV_DSTEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_DUST* ZP_RHOA(:) / XMD
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_DUST* ZP_RHOA(:,1) / XMD
END DO
!sea salt conversion : from part/part to kg/m3
DO JLAYER=NSV_SLTBEG,NSV_SLTEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_SALT* ZP_RHOA(:) / XMD
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_SALT* ZP_RHOA(:,1) / XMD
END DO
!
!blowing snow conversion : from kg(snow)/kg(dry air) to kg(snow)/m3
DO JLAYER=NSV_SNWBEG,NSV_SNWEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:)
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:,1)
END DO
IF(LBLOWSNOW) THEN ! Convert 2D blowing snow fields
! from kg(snow)/kg(dry air) to kg(snow)/m3
DO JLAYER=(NSV+1),KSV_SURF
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:)
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:,1)
END DO
END IF
!
@@ -1170,18 +1391,35 @@ ISHAPE_2 = (/KDIM1,KDIM2/)
!
! Arguments in call to surface:
!
-ZSFTH = XUNDEF_SFX
-ZSFTQ = XUNDEF_SFX
+ZSFTH = XUNDEF_SFX
+ZSFTH_SURF = XUNDEF_SFX
+ZSFTH_WALL = XUNDEF_SFX
+ZSFTH_ROOF = XUNDEF_SFX
+ZCD_ROOF = XUNDEF_SFX
+ZSFTQ = XUNDEF_SFX
+ZSFTQ_SURF = XUNDEF_SFX
+ZSFTQ_WALL = XUNDEF_SFX
+ZSFTQ_ROOF = XUNDEF_SFX
+!
IF (NSV>0) ZSFTS = XUNDEF_SFX
ZSFCO2 = XUNDEF_SFX
ZSFU = XUNDEF_SFX
ZSFV = XUNDEF_SFX
!
-ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2)
-ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2)
+ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2)
+ZSFTH_SURF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_SURF(:), ISHAPE_2)
+ZSFTH_WALL (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_WALL(:), ISHAPE_2)
+ZSFTH_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_ROOF(:), ISHAPE_2)
+ZCD_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_CD_ROOF(:), ISHAPE_2)
+ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2)
+ZSFTQ_SURF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_SURF(:), ISHAPE_2)
+ZSFTQ_WALL (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_WALL(:), ISHAPE_2)
+ZSFTQ_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_ROOF(:), ISHAPE_2)
+!
DO JLAYER=1,SIZE(PSFSV,3)
ZSFTS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,JLAYER), ISHAPE_2)
END DO
+!
ZSFCO2 (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFCO2(:), ISHAPE_2)
ZSFU (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFU(:), ISHAPE_2)
ZSFV (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFV(:), ISHAPE_2)
@@ -1195,7 +1433,7 @@ IF(LBLOWSNOW) THEN
END DO
END IF
!
-IF (LDIAG_IN_RUN) THEN
+IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
XCURRENT_RN (IIB:IIE,IJB:IJE) = RESHAPE(ZP_RN(:), ISHAPE_2)
XCURRENT_H (IIB:IIE,IJB:IJE) = RESHAPE(ZP_H (:), ISHAPE_2)
XCURRENT_LE (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LE(:), ISHAPE_2)
@@ -1204,10 +1442,12 @@ IF (LDIAG_IN_RUN) THEN
XCURRENT_T2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_T2M(:), ISHAPE_2)
XCURRENT_Q2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_Q2M(:), ISHAPE_2)
XCURRENT_HU2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_HU2M(:), ISHAPE_2)
+END IF
+IF ( GSTATPROF_SURF .OR. CPROGRAM == 'DIAG' ) THEN
XCURRENT_ZON10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZON10M(:), ISHAPE_2)
XCURRENT_MER10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_MER10M(:), ISHAPE_2)
- XCURRENT_ZWS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZWS(:), ISHAPE_2)
-ENDIF
+ ! XCURRENT_ZWS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZWS(:), ISHAPE_2)
+END IF
!
DO JLAYER=1,SIZE(PDIR_ALB,3)
PDIR_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_DIR_ALB(:,JLAYER), ISHAPE_2)
@@ -1224,6 +1464,7 @@ DEALLOCATE(ZP_V )
DEALLOCATE(ZP_QA )
DEALLOCATE(ZP_TA )
DEALLOCATE(ZP_RHOA )
+DEALLOCATE(ZP_TKE )
DEALLOCATE(ZP_SV )
DEALLOCATE(ZP_CO2 )
DEALLOCATE(ZP_RAIN )
@@ -1234,9 +1475,16 @@ DEALLOCATE(ZP_SCA_SW )
DEALLOCATE(ZP_PS )
DEALLOCATE(ZP_PA )
DEALLOCATE(ZP_ZWS )
-
-DEALLOCATE(ZP_SFTQ )
-DEALLOCATE(ZP_SFTH )
+!
+DEALLOCATE(ZP_SFTQ )
+DEALLOCATE(ZP_SFTQ_SURF)
+DEALLOCATE(ZP_SFTQ_WALL)
+DEALLOCATE(ZP_SFTQ_ROOF)
+DEALLOCATE(ZP_SFTH )
+DEALLOCATE(ZP_SFTH_SURF)
+DEALLOCATE(ZP_SFTH_WALL)
+DEALLOCATE(ZP_SFTH_ROOF)
+DEALLOCATE(ZP_CD_ROOF)
DEALLOCATE(ZP_SFTS )
DEALLOCATE(ZP_SFCO2 )
DEALLOCATE(ZP_SFU )
@@ -1245,16 +1493,20 @@ DEALLOCATE(ZP_TSRAD )
DEALLOCATE(ZP_DIR_ALB )
DEALLOCATE(ZP_SCA_ALB )
DEALLOCATE(ZP_EMIS )
-DEALLOCATE(ZP_RN )
-DEALLOCATE(ZP_H )
-DEALLOCATE(ZP_LE )
-DEALLOCATE(ZP_LEI )
-DEALLOCATE(ZP_GFLUX )
-DEALLOCATE(ZP_T2M )
-DEALLOCATE(ZP_Q2M )
-DEALLOCATE(ZP_HU2M )
-DEALLOCATE(ZP_ZON10M )
-DEALLOCATE(ZP_MER10M )
+IF ( GSTATPROF_SURF ) THEN
+ DEALLOCATE(ZP_RN )
+ DEALLOCATE(ZP_H )
+ DEALLOCATE(ZP_LE )
+ DEALLOCATE(ZP_LEI )
+ DEALLOCATE(ZP_GFLUX )
+ DEALLOCATE(ZP_T2M )
+ DEALLOCATE(ZP_Q2M )
+ DEALLOCATE(ZP_HU2M )
+END IF
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ DEALLOCATE(ZP_ZON10M )
+ DEALLOCATE(ZP_MER10M )
+END IF
DEALLOCATE(ZP_PEW_A_COEF )
DEALLOCATE(ZP_PEW_B_COEF )
diff --git a/ext/ini_budget.f90 b/ext/ini_budget.f90
index 2e61b72bed99db11509810ea930150f476d25f4d..6e8895afca14422904c7d7c6af66ad6a8063dd10 100644
--- a/ext/ini_budget.f90
+++ b/ext/ini_budget.f90
@@ -106,7 +106,7 @@ end subroutine Budget_preallocate
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
OHORELAX_SV, OVE_RELAX, ove_relax_grd, OCHTRANS, &
- ONUDGING,ODRAGTREE,ODEPOTREE, OAERO_EOL, &
+ ONUDGING,ODRAGTREE,ODEPOTREE, ODRAGBLDG, OAERO_EOL, &
HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
! #################################################################
!
@@ -208,6 +208,7 @@ end subroutine Budget_preallocate
! P. Wautelet 02/03/2021: budgets: add terms for blowing snow
! P. Wautelet 04/03/2021: budgets: add terms for drag due to buildings
! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
! C. Barthe 14/03/2022: budgets: add terms for CIBU and RDSF in LIMA
! M. Taufour 01/07/2022: budgets: add concentration for snow, graupel, hail
!-------------------------------------------------------------------------------
@@ -302,6 +303,7 @@ LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree
+LOGICAL, INTENT(IN) :: ODRAGBLDG ! switch to activate building drag
LOGICAL, INTENT(IN) :: OAERO_EOL ! switch to activate wind turbine wake
CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
@@ -1038,6 +1040,11 @@ if ( lbu_rth ) then
tzsource%lavailable = lblaze
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'heat released by buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
tzsource%cmnhname = 'VTURB'
tzsource%clongname = 'vertical turbulent diffusion'
tzsource%lavailable = hturb == 'TKEL'
@@ -1463,6 +1470,11 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'vapor released by buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
tzsource%cmnhname = 'BLAZE'
tzsource%clongname = 'blaze fire model contribution'
tzsource%lavailable = lblaze
diff --git a/ext/ini_modeln.f90 b/ext/ini_modeln.f90
index edbb56091a02f205040239abed144d7a789e5473..f1b7d80691b9cfcba7d1951f2fd54abace79fd96 100644
--- a/ext/ini_modeln.f90
+++ b/ext/ini_modeln.f90
@@ -292,8 +292,10 @@ END MODULE MODI_INI_MODEL_n
! S. Riette 04/2020: XHL* fields
! F. Auguste 02/2021: add IBM
! T.Nigel 02/2021: add turbulence recycling
-! J.L.Redelsperger 06/2011: OCEAN case
-! A. Costes 12/2021: Blaze fire model
+! J.L.Redelsperger 06/2011: OCEAN case
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
+! R. Schoetter 12/2021 adds humidity and other mean diagnostics
+! A. Costes 12/2021: Blaze fire model
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -334,6 +336,7 @@ USE MODD_DIAG_FLAG, only: LCHEMDIAG, CSPEC_BU_DIAG
USE MODD_DIM_n
USE MODD_DRAG_n
USE MODD_DRAGTREE_n
+USE MODD_DRAGBLDG_n
USE MODD_DUST
use MODD_DUST_OPT_LKT, only: NMAX_RADIUS_LKT_DUST=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_DUST=>NMAX_SIGMA_LKT, &
NMAX_WVL_SW_DUST=>NMAX_WVL_SW, &
@@ -525,9 +528,6 @@ INTEGER :: IIU_B,IJU_B
INTEGER :: IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZCO2 ! CO2 concentration near the surface
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSEA ! sea fraction
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTOWN ! town fraction
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZBARE ! bare soil fraction
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
@@ -778,6 +778,17 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XTKEM_MEAN(0,0,0))
END IF
ALLOCATE(XPABSM_MEAN(IIU,IJU,IKU)) ; XPABSM_MEAN = 0.0
+ ALLOCATE(XQ_MEAN(IIU,IJU,IKU)) ; XQ_MEAN = 0.0
+ ALLOCATE(XRH_W_MEAN(IIU,IJU,IKU)) ; XRH_W_MEAN = 0.0
+ ALLOCATE(XRH_I_MEAN(IIU,IJU,IKU)) ; XRH_I_MEAN = 0.0
+ ALLOCATE(XRH_P_MEAN(IIU,IJU,IKU)) ; XRH_P_MEAN = 0.0
+ ALLOCATE(XRH_W_MAXCOL_MEAN(IIU,IJU)) ; XRH_W_MAXCOL_MEAN = 0.0
+ ALLOCATE(XRH_I_MAXCOL_MEAN(IIU,IJU)) ; XRH_I_MAXCOL_MEAN = 0.0
+ ALLOCATE(XRH_P_MAXCOL_MEAN(IIU,IJU)) ; XRH_P_MAXCOL_MEAN = 0.0
+ ALLOCATE(XWIFF_MEAN(IIU,IJU,IKU)) ; XWIFF_MEAN = 0.0
+ ALLOCATE(XWIDD_MEAN(IIU,IJU,IKU)) ; XWIDD_MEAN = 0.0
+ ALLOCATE(XWIFF_MAX (IIU,IJU,IKU)) ; XWIFF_MAX = 0.0
+ ALLOCATE(XWIDD_MAX (IIU,IJU,IKU)) ; XWIDD_MAX = 0.0
!
ALLOCATE(XU2_M2(IIU,IJU,IKU)) ; XU2_M2 = 0.0
!
@@ -1832,7 +1843,7 @@ IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN
LHORELAX_UVWTH,LHORELAX_RV, LHORELAX_RC,LHORELAX_RR, &
LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, LHORELAX_RH,LHORELAX_TKE, &
LHORELAX_SV, LVE_RELAX, LVE_RELAX_GRD, &
- LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LMAIN_EOL, &
+ LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LDRAGBLDG,LMAIN_EOL, &
CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD )
END IF
!
@@ -2642,17 +2653,6 @@ IF (CRAD == 'ECMW') THEN
!* get cover mask for aerosols
!
IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ALLOCATE(ZTOWN(IIU,IJU))
- ALLOCATE(ZBARE(IIU,IJU))
- IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(KMI)
- CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
- ELSE
- ZSEA (:,:) = 1.
- ZTOWN(:,:) = 0.
- ZBARE(:,:) = 0.
- END IF
!
IF ( CAOP=='EXPL' .AND. LDUST .AND. KMI==1) THEN
ALLOCATE( XEXT_COEFF_WVL_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
@@ -2670,9 +2670,8 @@ IF (CRAD == 'ECMW') THEN
!
CALL INI_RADIATIONS_ECMWF (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
+ XSTATM, XOZON, XAER,XDST_WL, LSUBG_COND )
!
- DEALLOCATE(ZSEA,ZTOWN,ZBARE)
ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
XAER_CLIM(:,:,:,:) =XAER(:,:,:,:)
!
@@ -2683,23 +2682,11 @@ ELSE IF (CRAD == 'ECRA') THEN
!* get cover mask for aerosols
!
IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ALLOCATE(ZTOWN(IIU,IJU))
- ALLOCATE(ZBARE(IIU,IJU))
- IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(KMI)
- CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
- ELSE
- ZSEA (:,:) = 1.
- ZTOWN(:,:) = 0.
- ZBARE(:,:) = 0.
- END IF
!
CALL INI_RADIATIONS_ECRAD (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
+ XSTATM, XOZON, XAER,XDST_WL, LSUBG_COND )
- DEALLOCATE(ZSEA,ZTOWN,ZBARE)
ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
XAER_CLIM(:,:,:,:) = XAER(:,:,:,:)
!
diff --git a/ext/ini_segn.f90 b/ext/ini_segn.f90
index 8e034ced7f1cf068fda60861f09b102e8dc4604f..9299f713c570da1307054de55657bf040c94a415 100644
--- a/ext/ini_segn.f90
+++ b/ext/ini_segn.f90
@@ -323,7 +323,7 @@ CALL DEFAULT_DESFM_n(KMI)
!* 3. READ INITIAL FILE NAME AND OPEN INITIAL FILE
! --------------------------------------------
!
-CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND)
+CALL POSNAM( TZFILE_DES, 'NAM_LUNITN', GFOUND )
IF (GFOUND) THEN
CALL INIT_NAM_LUNITn
READ(UNIT=ILUSEG,NML=NAM_LUNITn)
@@ -336,9 +336,9 @@ END IF
IF (CPROGRAM=='MESONH') THEN
IF (KMI.EQ.1) THEN
- CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
+ CALL POSNAM( TZFILE_DES, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
- CALL POSNAM(ILUSEG,'NAM_CONFIO',GFOUND,ILUOUT)
+ CALL POSNAM( TZFILE_DES, 'NAM_CONFIO', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFIO)
CALL IO_Config_set()
END IF
diff --git a/ext/latlon_to_xy.f90 b/ext/latlon_to_xy.f90
index b969a76f470de6daf738ff1ef67b08753224b1ff..d5879356511d4b00f687923928cb4535ee4289ed 100644
--- a/ext/latlon_to_xy.f90
+++ b/ext/latlon_to_xy.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2023 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.
@@ -147,16 +147,14 @@ CALL IO_File_add2list(TZNMLFILE,'LATLON2XY1.nam','NML','READ')
CALL IO_File_open(TZNMLFILE)
INAM=TZNMLFILE%NLU
!
-CALL POSNAM(INAM,'NAM_INIFILE',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_INIFILE', GFOUND )
IF (GFOUND) THEN
READ(UNIT=INAM,NML=NAM_INIFILE)
- PRINT*, ' namelist NAM_INIFILE read'
END IF
!
-CALL POSNAM(INAM,'NAM_CONFIO',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) THEN
READ(UNIT=INAM,NML=NAM_CONFIO)
- PRINT*, ' namelist NAM_CONFIO read'
END IF
!
CALL IO_Config_set()
diff --git a/ext/lesn.f90 b/ext/lesn.f90
index 6376d8360e303dc35c72a93820cace8d7ce6ed44..6411b6cc5518e610d79264dfc126b8f9f38c6a79 100644
--- a/ext/lesn.f90
+++ b/ext/lesn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 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.
@@ -878,7 +878,9 @@ END DO
!
IF (NLES_CURRENT_TCOUNT==1) THEN
ALLOCATE(ZZ_LES (IIU,IJU,NLES_K))
+ !ZZ_LES = vertical position of the mass points where data is computed
CALL LES_VER_INT( MZF(XZZ) ,ZZ_LES )
+ !XLES_Z = mean vertical altitude for each level (taking into account the mask)
CALL LES_MEAN_ll ( ZZ_LES, LLES_CURRENT_CART_MASK, XLES_Z )
DEALLOCATE(ZZ_LES)
CALL LES_MEAN_ll ( XZS, LLES_CURRENT_CART_MASK(:,:,1), XLES_ZS )
diff --git a/ext/mnh2lpdm.f90 b/ext/mnh2lpdm.f90
index d00036b2e9da0be4bf25c177c9af6c21be11ea69..e5472663fb4f3727590afe015482fcab299981f6 100644
--- a/ext/mnh2lpdm.f90
+++ b/ext/mnh2lpdm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2023 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.
@@ -113,7 +113,7 @@ READ(UNIT=IFNML,NML=NAM_TURB)
READ(UNIT=IFNML,NML=NAM_FIC)
print *,'Lecture de NAM_FIC OK.'
-CALL POSNAM(IFNML,'NAM_CONFIO',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) THEN
READ(UNIT=IFNML,NML=NAM_CONFIO)
END IF
diff --git a/ext/modeln.f90 b/ext/modeln.f90
index bd57f893d6501adffa2dfd8739dc49bd671ad13d..8079f0d349befbd4bfe24c02d47f30d77d1f9ce2 100644
--- a/ext/modeln.f90
+++ b/ext/modeln.f90
@@ -277,11 +277,13 @@ END MODULE MODI_MODEL_n
! T. Nagel 01/02/2021: add turbulence recycling
! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
! A. Costes 12/2021: add Blaze fire model
! C. Barthe 07/04/2022: deallocation of ZSEA
! P. Wautelet 08/12/2022: bugfix if no TDADFILE
! P. Wautelet 13/01/2023: manage close of backup files outside of MODEL_n
! (useful to close them in reverse model order (child before parent, needed by WRITE_BALLOON_n)
+! J. Wurtz 01/2023 : correction for mean in SURFEX outputs
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -321,6 +323,7 @@ USE MODD_DYNZD_n
USE MODD_ELEC_DESCR
USE MODD_EOL_MAIN
USE MODD_FIELD_n
+USE MODD_FIRE_n
USE MODD_FRC
USE MODD_FRC_n
USE MODD_GET_n
@@ -397,8 +400,7 @@ USE MODE_ONE_WAY_n
USE MODE_WRITE_AIRCRAFT_BALLOON
use mode_write_les_n, only: Write_les_n
use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
-USE MODE_WRITE_PROFILER_n, ONLY: WRITE_PROFILER_n
-USE MODE_WRITE_STATION_n, ONLY: WRITE_STATION_n
+USE MODE_WRITE_STATPROF_n, ONLY: WRITE_STATPROF_n
!
USE MODI_ADDFLUCTUATIONS
USE MODI_ADVECTION_METSV
@@ -466,7 +468,6 @@ USE MODI_WRITE_LFIFM_n
USE MODI_WRITE_SERIES_n
USE MODI_WRITE_SURF_ATM_N
!
-USE MODD_FIRE_n
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -1031,10 +1032,10 @@ IF ( nfile_backup_current < NBAK_NUMB ) THEN
IF (CSURF=='EXTE') THEN
TFILE_SURFEX => TPBAKFILE
CALL GOTO_SURFEX(IMI)
- CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
+ CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
IF ( KTCOUNT > 1) THEN
CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
- CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
+ CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL', KTCOUNT/nfile_backup_current)
END IF
NULLIFY(TFILE_SURFEX)
END IF
@@ -2113,7 +2114,7 @@ XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
! --------------------
!
IF (LMEAN_FIELD) THEN
- CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XRT(:,:,:,1), XSVT(:,:,:,1))
END IF
!
!-------------------------------------------------------------------------------
@@ -2191,7 +2192,7 @@ END IF
! --------------------------------
!
IF ( LSTATION ) &
- CALL STATION_n( XZZ, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
+ CALL STATION_n( XZZ, XRHODREF, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
!
!---------------------------------------------------------
!
@@ -2271,8 +2272,8 @@ IF (OEXIT) THEN
IF ( .NOT. LIO_NO_WRITE ) THEN
IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE)
CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
- CALL WRITE_STATION_n(TDIAFILE)
- CALL WRITE_PROFILER_n(TDIAFILE)
+ CALL WRITE_STATPROF_n( TDIAFILE, TSTATIONS )
+ CALL WRITE_STATPROF_n( TDIAFILE, TPROFILERS )
call Write_les_n( tdiafile )
#ifdef MNH_IOLFI
CALL MENU_DIACHRO(TDIAFILE,'END')
diff --git a/ext/phys_paramn.f90 b/ext/phys_paramn.f90
index d1c53a2defe126e82caf00d1c7efce45c8b37bf0..ef93f2ccca1bcd8df3a68c8ada3b37176d740461 100644
--- a/ext/phys_paramn.f90
+++ b/ext/phys_paramn.f90
@@ -237,9 +237,10 @@ END MODULE MODI_PHYS_PARAM_n
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
! F. Auguste 02/2021: add IBM
! JL Redelsperger 03/2021: add the SW flux penetration for Ocean model case
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
! P. Wautelet 30/11/2022: compute XTHW_FLUX, XRCW_FLUX and XSVW_FLUX only when needed
! A. Costes 12/2021: add Blaze fire model
-! Q. Rodier 2022: integration with PHYEX
+! Q. Rodier 2022 : integration with PHYEX
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -387,6 +388,12 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV ! surface flux of vapor
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSFSV ! surface flux of scalars
REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFCO2! surface flux of CO2
!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFTH_WALL
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFTH_ROOF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCD_ROOF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV_WALL
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV_ROOF
+!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity
@@ -492,7 +499,7 @@ IKB = 1 + JPVEXT
IKE = IKU - JPVEXT
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3),.TRUE., NLES_TIMES)
+CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3),.TRUE.,NLES_TIMES)
!
ZTIME1 = 0.0_MNHTIME
ZTIME2 = 0.0_MNHTIME
@@ -511,6 +518,12 @@ ALLOCATE(ZSFRV (IIU,IJU))
ALLOCATE(ZSFSV (IIU,IJU,NSV))
ALLOCATE(ZSFCO2(IIU,IJU))
!
+ALLOCATE(ZSFTH_WALL (IIU,IJU))
+ALLOCATE(ZSFTH_ROOF (IIU,IJU))
+ALLOCATE(ZCD_ROOF (IIU,IJU))
+ALLOCATE(ZSFRV_WALL (IIU,IJU))
+ALLOCATE(ZSFRV_ROOF (IIU,IJU))
+!
!* if XWAY(son)=2 save surface fields before radiation or convective scheme
! calls
!
@@ -1265,8 +1278,8 @@ IF (CSURF=='EXTE') THEN
DEALLOCATE( ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV)
DEALLOCATE( ZSAVE_DIRFLASWD,ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD)
END IF
- CALL GROUND_PARAM_n(YLDIMPHYEX,ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
- ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD, KTCOUNT, TPFILE )
+ CALL GROUND_PARAM_n(YLDIMPHYEX,ZSFTH, ZSFTH_WALL, ZSFTH_ROOF, ZCD_ROOF, ZSFRV, ZSFRV_WALL, ZSFRV_ROOF, &
+ ZSFSV, ZSFCO2, ZSFU, ZSFV, ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD, KTCOUNT, TPFILE )
!
IF (LIBM) THEN
WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
@@ -1303,6 +1316,11 @@ IF (CSURF=='EXTE') THEN
ELSE ! case no SURFEX (CSURF logical)
ZSFSV = 0.
ZSFCO2 = 0.
+ ZSFTH_WALL = 0.
+ ZSFTH_ROOF = 0.
+ ZCD_ROOF = 0.
+ ZSFRV_WALL = 0.
+ ZSFRV_ROOF = 0.
IF (.NOT.LOCEAN) THEN
ZSFTH = 0.
ZSFRV = 0.
@@ -1368,11 +1386,53 @@ ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFTH_WALL, 'PHYS_PARAM_n::ZSFTH_WALL')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFTH_ROOF, 'PHYS_PARAM_n::ZSFTH_ROOF')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZCD_ROOF, 'PHYS_PARAM_n::ZCD_ROOF')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFRV_WALL, 'PHYS_PARAM_n::ZSFRV_WALL')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFRV_ROOF, 'PHYS_PARAM_n::ZSFRV_ROOF')
+!
+IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ ZSFTH_WALL(IIB-1,:)=ZSFTH_WALL(IIB,:)
+ ZSFTH_ROOF(IIB-1,:)=ZSFTH_ROOF(IIB,:)
+ ZCD_ROOF (IIB-1,:)=ZCD_ROOF(IIB,:)
+ ZSFRV_WALL(IIB-1,:)=ZSFRV_WALL(IIB,:)
+ ZSFRV_ROOF(IIB-1,:)=ZSFRV_ROOF(IIB,:)
+ENDIF
+!
+IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ ZSFTH_WALL(IIE+1,:)=ZSFTH_WALL(IIE,:)
+ ZSFTH_ROOF(IIE+1,:)=ZSFTH_ROOF(IIE,:)
+ ZCD_ROOF(IIE+1,:) =ZCD_ROOF(IIE,:)
+ ZSFRV_WALL(IIE+1,:)=ZSFRV_WALL(IIE,:)
+ ZSFRV_ROOF(IIE+1,:)=ZSFRV_ROOF(IIE,:)
+ENDIF
+!
+IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ ZSFTH_WALL(:,IJB-1)=ZSFTH_WALL(:,IJB)
+ ZSFTH_ROOF(:,IJB-1)=ZSFTH_ROOF(:,IJB)
+ ZCD_ROOF(:,IJB-1) =ZCD_ROOF(:,IJB)
+ ZSFRV_WALL(:,IJB-1)=ZSFRV_WALL(:,IJB)
+ ZSFRV_ROOF(:,IJB-1)=ZSFRV_ROOF(:,IJB)
+ENDIF
+!
+IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ ZSFTH_WALL(:,IJE+1)=ZSFTH_WALL(:,IJE)
+ ZSFTH_ROOF(:,IJE+1)=ZSFTH_ROOF(:,IJE)
+ ZCD_ROOF(:,IJE+1)=ZCD_ROOF(:,IJE)
+ ZSFRV_WALL(:,IJE+1)=ZSFRV_WALL(:,IJE)
+ ZSFRV_ROOF(:,IJE+1)=ZSFRV_ROOF(:,IJE)
+ENDIF
+!
+!
IF (LDRAGTREE) CALL DRAG_VEG( XTSTEP, XUT, XVT, XTKET, LDEPOTREE, XVDEPOTREE, &
CCLOUD, XPABST, XTHT, XRT, XSVT, XRHODJ, XZZ, &
XRUS, XRVS, XRTKES, XRRS, XRSVS )
!
-IF (LDRAGBLDG) CALL DRAG_BLD( XTSTEP, XUT, XVT, XTKET, XRHODJ, XZZ, XRUS, XRVS, XRTKES )
+IF (LDRAGBLDG) CALL DRAG_BLD ( XTSTEP, XUT, XVT, XTKET, XPABST, XTHT, XRT, XSVT, &
+ XRHODJ, XZZ, XRUS, XRVS, XRTKES, XRTHS, XRRS, &
+ ZSFTH_WALL, ZSFTH_ROOF, ZCD_ROOF, ZSFRV_WALL, &
+ ZSFRV_ROOF )
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1693,6 +1753,11 @@ DEALLOCATE(ZSFRV )
DEALLOCATE(ZSFSV )
DEALLOCATE(ZSFCO2)
!
+DEALLOCATE(ZSFTH_WALL )
+DEALLOCATE(ZSFTH_ROOF )
+DEALLOCATE(ZCD_ROOF )
+DEALLOCATE(ZSFRV_WALL )
+DEALLOCATE(ZSFRV_ROOF )
!-------------------------------------------------------------------------------
!
END SUBROUTINE PHYS_PARAM_n
diff --git a/ext/prep_ideal_case.f90 b/ext/prep_ideal_case.f90
index 9b4c61fad08449e598520f875e4975d227713bc4..25eac5bc19829db1276abb1fb4def279fa28d9b8 100644
--- a/ext/prep_ideal_case.f90
+++ b/ext/prep_ideal_case.f90
@@ -361,7 +361,7 @@ USE MODD_LUNIT, ONLY: TLUOUT0, TOUTDATAFILE
USE MODD_LUNIT_n
USE MODD_IO, ONLY: TFILE_DUMMY, TFILE_OUTPUTLISTING
USE MODD_CONF_n
-USE MODD_NSV, ONLY: NSV
+USE MODD_NSV, ONLY: NSV, NSV_ASSOCIATE
use modd_precision, only: LFIINT, MNHREAL_MPI, MNHTIME
!
USE MODN_BLANK_n
@@ -656,6 +656,7 @@ CALL ALLOC_FIELD_SCALARS()
CALL TBUCONF_ASSOCIATE()
CALL LES_ASSOCIATE()
CALL DEFAULT_DESFM_n(1)
+CALL NSV_ASSOCIATE()
!
CSURF = "NONE"
!
@@ -686,35 +687,35 @@ NLUPRE=TZEXPREFILE%NLU
!* 3.2 read in NLUPRE the namelist informations
!
WRITE(NLUOUT,FMT=*) 'attempt to read ',TRIM(TZEXPREFILE%CNAME),' file'
-CALL POSNAM(NLUPRE,'NAM_REAL_PGD',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_REAL_PGD', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_REAL_PGD)
!
!
-CALL POSNAM(NLUPRE,'NAM_CONF_PRE',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_CONF_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONF_PRE)
!JUANZ
-CALL POSNAM(NLUPRE,'NAM_CONFZ',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFZ)
!JUANZ
-CALL POSNAM(NLUPRE,'NAM_CONFIO',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFIO)
CALL IO_Config_set()
-CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_GRID_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE)
-CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_GRIDH_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
-CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_VPROF_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
-CALL POSNAM(NLUPRE,'NAM_BLANKN',GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_BLANKN', GFOUND )
CALL INIT_NAM_BLANKn
IF (GFOUND) THEN
READ(UNIT=NLUPRE,NML=NAM_BLANKn)
CALL UPDATE_NAM_BLANKn
END IF
-CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
-CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT)
+CALL READ_PRE_IDEA_NAM_n( TZEXPREFILE )
+CALL POSNAM( TZEXPREFILE, 'NAM_AERO_PRE', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
-CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT)
+CALL POSNAM( TZEXPREFILE, 'NAM_IBM_LSF', GFOUND )
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
!
CALL INI_FIELD_LIST()
diff --git a/ext/prep_pgd.f90 b/ext/prep_pgd.f90
index 41c4a13988d5a89107b90a04cc434da82ca0bb7d..617389344cce3df0e04725dc6174037299dab045 100644
--- a/ext/prep_pgd.f90
+++ b/ext/prep_pgd.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2023 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.
@@ -191,23 +191,23 @@ IF (IRESP.NE.0 ) THEN
ENDIF
!JUAN
-CALL POSNAM(ILUNAM,'NAM_PGDFILE',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_PGDFILE', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
-CALL POSNAM(ILUNAM,'NAM_ZSFILTER',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_ZSFILTER', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_ZSFILTER)
-CALL POSNAM(ILUNAM,'NAM_SLEVE',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_SLEVE', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_SLEVE)
!JUANZ
-CALL POSNAM(ILUNAM,'NAM_CONFZ',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFZ)
-CALL POSNAM(ILUNAM,'NAM_CONF_PGD',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONF_PGD', GFOUND )
IF (GFOUND) THEN
NHALO_MNH = NHALO_CONF_MNH
READ(UNIT=ILUNAM,NML=NAM_CONF_PGD)
NHALO_CONF_MNH = NHALO_MNH
ENDIF
!JUANZ
-CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
CALL IO_Config_set()
!
diff --git a/ext/prep_real_case.f90 b/ext/prep_real_case.f90
index f71ccb8c4fb2cbfc1a31ef32393e13b5a4e717fe..8cedd2db6306022147be0c79c5aeaa100a8d237d 100644
--- a/ext/prep_real_case.f90
+++ b/ext/prep_real_case.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2023 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.
@@ -673,9 +673,9 @@ CALL INI_CST
IPRE_REAL1 = TZPRE_REAL1FILE%NLU
!
CALL INIT_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_REAL_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
-CALL PARAM_LIMA_INIT(CPROGRAM, IPRE_REAL1, .FALSE., ILUOUT0, .FALSE., .TRUE., .FALSE., 0)
+CALL PARAM_LIMA_INIT(CPROGRAM, TZPRE_REAL1FILE, .FALSE., ILUOUT0, .FALSE., .TRUE., .FALSE., 0)
!
CALL INI_FIELD_LIST()
!
@@ -744,18 +744,18 @@ XANGCONV0=0. ; XANGCONV1000=0. ; XANGCONV2000=0.
CDADATMFILE=' ' ; CDADBOGFILE=' '
!
CALL INIT_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_REAL_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_HURR_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_HURR_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_HURR_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_CH_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_CH_CONF', GFOUND )
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CH_CONF)
CALL UPDATE_MODD_FROM_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_CONFZ',GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
-CALL POSNAM(IPRE_REAL1,'NAM_IBM_LSF' ,GFOUND,ILUOUT0)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_IBM_LSF' , GFOUND )
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF)
!
GAERINIT = LAERINIT
@@ -808,7 +808,7 @@ END IF
!
!IF(LEN_TRIM(YCHEMFILE)>0)THEN
! ! read again Nam_aero_conf
-! CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+! CALL POSNAM( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
! IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
! IF(YCHEMFILETYPE=='GRIBEX') &
! CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
@@ -842,7 +842,7 @@ END IF
!
IF(LEN_TRIM(YCHEMFILE)>0)THEN
! read again Nam_aero_conf
- CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+ CALL POSNAM( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
IF(YCHEMFILETYPE=='GRIBEX') &
CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
diff --git a/ext/profilern.f90 b/ext/profilern.f90
index 9a8b3f6690b14b87aab81805d67c413139149fb6..425ddf294fe45f0831ace0799a09e9cdf660735d 100644
--- a/ext/profilern.f90
+++ b/ext/profilern.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2023 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.
@@ -83,52 +83,25 @@ END MODULE MODI_PROFILER_n
! + bugfix: put values in variables in this case
! + move some operations outside a do loop
! P. Wautelet 04/2022: restructure profilers for better performance, reduce memory usage and correct some problems/bugs
+! P. Wautelet 01/06/2023: deduplicate code => moved to modd/mode_sensors.f90
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XCPD, XG, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XRV, XTT
-USE MODD_DIAG_IN_RUN
+USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
+USE MODD_CST, ONLY: XCPD, XG, XP00, XPI, XRD, XRV
+USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_TKE_DISS
USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
-USE MODD_NSV, ONLY: NSV_C2R2, NSV_C2R2BEG, NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR
+USE MODD_NSV, ONLY: NSV_C2R2BEG, NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
-USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I => LSNOW_T
-USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
- XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
- XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
- XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L => XDI, XLBEXI_L => XLBEXI, XLBI_L => XLBI, XAI_L => XAI, XBI_L => XBI, XC_I_L => XC_I, &
- XLBEXS_L => XLBEXS, XLBS_L => XLBS, XCCS_L => XCCS, &
- XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
- XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
- XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L => XDG, XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, &
- XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG, XCG_L => XCG
-USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L => XLBEXR, XLBR_L => XLBR, XBR_L => XBR, XAR_L => XAR, &
- XBC_L => XBC, XAC_L => XAC
-USE MODD_PARAM_n, ONLY: CCLOUD, CRAD, CSURF
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
USE MODD_PROFILER_n
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
- XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
- XALPHAC_I => XALPHAC, XNUC_I => XNUC, &
- XLBC_I => XLBC, XBC_I => XBC, XAC_I => XAC, &
- XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
- XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
- XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
- XALPHAG_I => XALPHAG, XNUG_I => XNUG, XDG_I => XDG, XLBEXG_I => XLBEXG, &
- XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, XCG_I => XCG, &
- XALPHAI_I => XALPHAI, XNUI_I => XNUI, XDI_I => XDI, XLBEXI_I => XLBEXI, &
- XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, XC_I_I => XC_I, &
- XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
- XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
- XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
!
USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: BHMIE, QEPSI, QEPSW, MG, MOMG
USE MODE_MSG
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT, STATPROF_INTERP_2D, STATPROF_INTERP_3D, &
- STATPROF_INTERP_3D_U, STATPROF_INTERP_3D_V
+USE MODE_SENSOR, ONLY: Sensor_rare_compute, Sensor_wc_compute
+USE MODE_STATPROF_TOOLS, ONLY: STATPROF_DIAG_SURFRAD
!
USE MODI_GPS_ZENITH_GRID
USE MODI_WATER_SUM
@@ -160,15 +133,13 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! for radar
! 0.2 declaration of local variables
!
!
-INTEGER, PARAMETER :: JPTS_GAULAG = 9 ! number of points for Gauss-Laguerre quadrature
-!
INTEGER :: IKB
INTEGER :: IKE
INTEGER :: IKU
!
!
-REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)) :: ZWORK
-REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PAER,4)) :: ZWORK2
+REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)) :: ZWORK
+REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PAER,4)) :: ZWORK2
!
INTEGER :: IN ! time index
INTEGER :: JSV ! loop counter
@@ -209,26 +180,6 @@ REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZVISIGUL, ZVISIKUN
REAL :: ZK1,ZK2,ZK3 ! k1, k2 and K3 atmospheric refractivity constants
REAL :: ZRDSRV ! XRD/XRV
!
-! specific to cloud radar
-INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
-REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
-REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
-REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
-REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
-REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
-INTEGER :: JJ ! loop counter for quadrature
-COMPLEX :: QMW,QMI,QM,QB,QEPSIW,QEPSWI ! dielectric parameter
-REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
-REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
-REAL :: ZFW ! liquid fraction
-REAL :: ZFPW ! weight for mixed-phase reflectivity
-REAL :: ZN ! number concentration
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
-LOGICAL :: GCALC
!----------------------------------------------------------------------------
!
!* 2. PRELIMINARIES
@@ -254,15 +205,13 @@ IKE = IKU-JPVEXT
!* 3.4 instant of storage
! ------------------
!
-CALL STATPROF_INSTANT( TPROFILERS_TIME, IN )
-IF ( IN < 1 ) RETURN !No profiler storage at this time step
+IF ( .NOT. TPROFILERS_TIME%STORESTEP_CHECK_AND_SET( IN ) ) RETURN !No profiler storage at this time step
!
!----------------------------------------------------------------------------
!
!* 8. DATA RECORDING
! --------------
!
-!PW: TODO: ne faire le calcul que si necessaire (presence de profileurs locaux,...)
ZTEMP(:,:,:)=PTH(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
! Theta_v
ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
@@ -287,12 +236,14 @@ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
END IF
!
PROFILER: DO JP = 1, NUMBPROFILER_LOC
- ZZ(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PZ )
- ZRHOD(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PRHODREF )
- ZPRES(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PP )
- ZU_PROFILER(:) = STATPROF_INTERP_3D_U( TPROFILERS(JP), PU )
- ZV_PROFILER(:) = STATPROF_INTERP_3D_V( TPROFILERS(JP), PV )
- ZGAM = (XRPK * (TPROFILERS(JP)%XLON - XLON0) - XBETA)*(XPI/180.)
+ TPROFILERS(JP)%NSTORE_CUR = IN
+
+ ZZ(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PZ )
+ ZRHOD(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PRHODREF )
+ ZPRES(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PP )
+ ZU_PROFILER(:) = TPROFILERS(JP)%INTERP_HOR_FROM_UPOINT( PU )
+ ZV_PROFILER(:) = TPROFILERS(JP)%INTERP_HOR_FROM_VPOINT( PV )
+ ZGAM = (XRPK * (TPROFILERS(JP)%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
ZFF(:) = SQRT(ZU_PROFILER(:)**2 + ZV_PROFILER(:)**2)
DO JK=1,IKU
IF (ZU_PROFILER(JK) >=0. .AND. ZV_PROFILER(JK) > 0.) &
@@ -307,15 +258,15 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
ZDD(JK) = XUNDEF
END DO
! GPS IWV and ZTD
- XZS_GPS=TPROFILERS(JP)%XZ
+ XZS_GPS=TPROFILERS(JP)%XZ_CUR
IF ( ABS( ZZ(IKB)-XZS_GPS ) < 150 ) THEN ! distance between real and model orography ok
- ZRV(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,1) )
- ZT(:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMP )
+ ZRV(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,1) )
+ ZT(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTEMP )
ZE(:) = ZPRES(:)*ZRV(:)/(ZRDSRV+ZRV(:))
- ZTV(:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMPV )
- ZZTD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZTD )
- ZZHD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZHD )
- ZZWD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZWD )
+ ZTV(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTEMPV )
+ ZZTD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZTD )
+ ZZHD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZHD )
+ ZZWD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZWD )
ZIWV = 0.
DO JK=IKB,IKE
ZIWV=ZIWV+ZRHOD(JK)*ZRV(JK)*(ZZ(JK+1)-ZZ(JK))
@@ -372,312 +323,39 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
TPROFILERS(JP)%XZWD(IN)= XUNDEF
TPROFILERS(JP)%XZHD(IN)= XUNDEF
END IF
- TPROFILERS(JP)%XZON (IN,:) = ZU_PROFILER(:) * COS(ZGAM) + ZV_PROFILER(:) * SIN(ZGAM)
- TPROFILERS(JP)%XMER (IN,:) = - ZU_PROFILER(:) * SIN(ZGAM) + ZV_PROFILER(:) * COS(ZGAM)
- TPROFILERS(JP)%XFF (IN,:) = ZFF(:)
- TPROFILERS(JP)%XDD (IN,:) = ZDD(:)
- TPROFILERS(JP)%XW (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PW )
- TPROFILERS(JP)%XTH (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PTH )
- TPROFILERS(JP)%XTHV (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTHV )
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) TPROFILERS(JP)%XVISIGUL(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZVISIGUL )
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) TPROFILERS(JP)%XVISIKUN(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZVISIKUN )
- TPROFILERS(JP)%XZZ (IN,:) = ZZ(:)
- TPROFILERS(JP)%XRHOD(IN,:) = ZRHOD(:)
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) &
- TPROFILERS(JP)%XCIZ(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PCIT )
-! add RARE
- ! initialization CRARE and CRARE_ATT + LWC and IWC
- TPROFILERS(JP)%XCRARE(IN,:) = 0.
- TPROFILERS(JP)%XCRARE_ATT(IN,:) = 0.
- TPROFILERS(JP)%XLWCZ (IN,:) = 0.
- TPROFILERS(JP)%XIWCZ (IN,:) = 0.
- IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
- TPROFILERS(JP)%XLWCZ (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), (PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:) )
- TPROFILERS(JP)%XIWCZ (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), (PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:) )
- ZTEMPZ(:)=STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMP(:,:,:) )
- ZRHODREFZ(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PRHODREF(:,:,:) )
- ZCIT(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PCIT(:,:,:) )
- IF (CCLOUD=="LIMA") THEN
- ZCCI(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NI) )
- ZCCR(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NR) )
- ZCCC(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NC) )
- END IF
- DO JLOOP=3,6
- ZRZ(:,JLOOP)=STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,JLOOP) )
- END DO
- IF (CSURF=="EXTE") THEN
- DO JK=1,IKU
- ZRZ(JK,2)=STATPROF_INTERP_2D( TPROFILERS(JP), PR(:,:,JK,2)*PSEA(:,:) ) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=STATPROF_INTERP_2D( TPROFILERS(JP), PR(:,:,JK,2)*(1.-PSEA(:,:)) ) ! becomes cloud mixing ratio over land
- END DO
- ELSE
- ZRZ(:,2)=STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,2) )
- ZRZ(:,7)=0.
- END IF
- ALLOCATE(ZAELOC(IKU))
- !
- ZAELOC(:)=0.
- ! initialization of quadrature points and weights
- ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
- CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
- ! initialize minimum values
- ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
- IF (CCLOUD == 'LIMA') THEN
- ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_L(3)
- ZRTMIN(4)=XRTMIN_L(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_L(6)
- ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
- ELSE
- ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_I(3)
- ZRTMIN(4)=XRTMIN_I(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_I(6)
- ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
- END IF
- ! compute cloud radar reflectivity from vertical profiles of temperature
- ! and mixing ratios
- DO JK=1,IKU
- QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- DO JLOOP=2,7
- IF (CCLOUD == 'LIMA') THEN
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
- (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND.JLOOP.NE.7).OR.ZCCC(JK)>0.))
- ELSE
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
- END IF
- IF (GCALC) THEN
- SELECT CASE(JLOOP)
- CASE(2) ! cloud water over sea
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_SEA
- ZCX=0.
- ZALPHA=XALPHAC2_I
- ZNU=XNUC2_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- END IF
- CASE(3) ! rain water
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAR_L
- ZB=XBR_L
- ZCC=ZCCR(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAR_L
- ZNU=XNUR_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAR_I
- ZB=XBR_I
- ZCC=XCCR_I
- ZCX=-1.
- ZALPHA=XALPHAR_I
- ZNU=XNUR_I
- ZLB=XLBR_I
- ZLBEX=XLBEXR_I
- END IF
- CASE(4) ! pristine ice
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAI_L
- ZB=XBI_L
- ZCC=ZCCI(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAI_L
- ZNU=XNUI_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ELSE
- ZA=XAI_I
- ZB=XBI_I
- ZCC=ZCIT(JK)
- ZCX=0.
- ZALPHA=XALPHAI_I
- ZNU=XNUI_I
- ZLBEX=XLBEXI_I
- ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- END IF
- CASE(5) ! snow
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAS_L
- ZB=XBS_L
- ZCC=XCCS_L
- ZCX=XCXS_L
- ZALPHA=XALPHAS_L
- ZNU=XNUS_L
- ZNS=XNS_L
- ZLB=XLBS_L
- ZLBEX=XLBEXS_L
- ZFW=0
- ELSE
- ZA=XAS_I
- ZB=XBS_I
- ZCC=XCCS_I
- ZCX=XCXS_I
- ZALPHA=XALPHAS_I
- ZNU=XNUS_I
- ZNS=XNS_I
- ZLB=XLBS_I
- ZLBEX=XLBEXS_I
- ZFW=0
- END IF
- CASE(6) ! graupel
- !If temperature between -10 and 10B0C and Mr and Mg over min
- !threshold: melting graupel
- ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel
- ! (Fw=0)
- IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
- .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
- ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
- ELSE
- ZFW=0
- END IF
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAG_L
- ZB=XBG_L
- ZCC=XCCG_L
- ZCX=XCXG_L
- ZALPHA=XALPHAG_L
- ZNU=XNUG_L
- ZLB=XLBG_L
- ZLBEX=XLBEXG_L
- ELSE
- ZA=XAG_I
- ZB=XBG_I
- ZCC=XCCG_I
- ZCX=XCXG_I
- ZALPHA=XALPHAG_I
- ZNU=XNUG_I
- ZLB=XLBG_I
- ZLBEX=XLBEXG_I
- END IF
- CASE(7) ! cloud water over land
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_LAND
- ZCX=0.
- ZALPHA=XALPHAC_I
- ZNU=XNUC_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- END IF
- END SELECT
- IF ( JLOOP == 5 .AND. CCLOUD=='LIMA'.AND.LSNOW_T_L ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE IF (JLOOP.EQ.5 .AND. (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE
- ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
- ZN=ZCC*ZLBDA**ZCX
- END IF
- ZREFLOC=0.
- ZAETMP=0.
- DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
- ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
- SELECT CASE(JLOOP)
- CASE(2,3,7)
- QM=QMW
- CASE(4,5,6)
- ! pristine ice, snow, dry graupel
- ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
- QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
- ! water inclusions in ice in air
- QEPSWI=MG(QMW**2,QM**2,ZFW)
- ! ice in air inclusions in water
- QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
- !MG weighted rule (Matrosov 2008)
- IF(ZFW .LT. 0.37) THEN
- ZFPW=0
- ELSE IF(ZFW .GT. 0.63) THEN
- ZFPW=1
- ELSE
- ZFPW=(ZFW-0.37)/(0.63-0.37)
- ENDIF
- QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
- END SELECT
- CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
- ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- END DO
- ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93)
- ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU))
- TPROFILERS(JP)%XCRARE(IN,JK)=TPROFILERS(JP)%XCRARE(IN,JK)+ZREFLOC
- ZAELOC(JK)=ZAELOC(JK)+ZAETMP
- END IF
- END DO
- END DO
- ! apply attenuation
- ALLOCATE(ZZMZ(IKU))
- ZZMZ = ZZ(:) ! STATPROF_INTERP_3D( TPROFILERS(JP), ZZM(:,:,:) )
-! ZZMZ(1)=ZZM_STAT
- ! zenith
- ZAETOT=1.
- DO JK = 2,IKU
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
- TPROFILERS(JP)%XCRARE_ATT(IN,JK)=TPROFILERS(JP)%XCRARE(IN,JK)*ZAETOT
- END DO
- DEALLOCATE(ZZMZ,ZAELOC)
- ! m^3 b mm^6/m^3 b dBZ
- WHERE(TPROFILERS(JP)%XCRARE(IN,:)>0)
- TPROFILERS(JP)%XCRARE(IN,:)=10.*LOG10(1.E18*TPROFILERS(JP)%XCRARE(IN,:))
- ELSEWHERE
- TPROFILERS(JP)%XCRARE(IN,:)=XUNDEF
- END WHERE
- WHERE(TPROFILERS(JP)%XCRARE_ATT(IN,:)>0)
- TPROFILERS(JP)%XCRARE_ATT(IN,:)=10.*LOG10(1.E18*TPROFILERS(JP)%XCRARE_ATT(IN,:))
- ELSEWHERE
- TPROFILERS(JP)%XCRARE_ATT(IN,:)=XUNDEF
- END WHERE
- DEALLOCATE(ZX,ZW,ZRTMIN)
- END IF ! end LOOP ICE3
-! end add RARE
-!!
- TPROFILERS(JP)%XP (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PP )
+ TPROFILERS(JP)%XZON (:,IN) = ZU_PROFILER(:) * COS(ZGAM) + ZV_PROFILER(:) * SIN(ZGAM)
+ TPROFILERS(JP)%XMER (:,IN) = - ZU_PROFILER(:) * SIN(ZGAM) + ZV_PROFILER(:) * COS(ZGAM)
+ TPROFILERS(JP)%XFF (:,IN) = ZFF(:)
+ TPROFILERS(JP)%XDD (:,IN) = ZDD(:)
+ TPROFILERS(JP)%XW (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PW )
+ TPROFILERS(JP)%XTH (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTH )
+ TPROFILERS(JP)%XTHV (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTHV )
+ IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) &
+ TPROFILERS(JP)%XVISIGUL(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZVISIGUL )
+ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) &
+ TPROFILERS(JP)%XVISIKUN(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZVISIKUN )
+ TPROFILERS(JP)%XZZ (:,IN) = ZZ(:)
+ TPROFILERS(JP)%XRHOD(:,IN) = ZRHOD(:)
+ IF (CCLOUD=="LIMA") THEN
+ TPROFILERS(JP)%XCIZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ TPROFILERS(JP)%XCCZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ TPROFILERS(JP)%XCRZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
+ ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
+ TPROFILERS(JP)%XCIZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PCIT )
+ END IF
+
+ CALL Sensor_wc_compute( TPROFILERS(JP), IN, PR, PRHODREF )
+ CALL Sensor_rare_compute( TPROFILERS(JP), IN, PR, PSV, PRHODREF, PCIT, ZTEMP, ZZ, PSEA )
+ !!
+ TPROFILERS(JP)%XP (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PP )
!
DO JSV=1,SIZE(PR,4)
- TPROFILERS(JP)%XR (IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,JSV) )
+ TPROFILERS(JP)%XR (:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JSV) )
END DO
ZWORK(:,:,:,:)=PSV(:,:,:,:)
ZWORK(:,:,1,:)=PSV(:,:,2,:)
DO JSV=1,SIZE(PSV,4)
- TPROFILERS(JP)%XSV (IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), ZWORK(:,:,:,JSV) )
+ TPROFILERS(JP)%XSV (:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZWORK(:,:,:,JSV) )
END DO
ZWORK2(:,:,:,:) = 0.
DO JK=IKB,IKE
@@ -685,29 +363,19 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
ZWORK2(:,:,JK,:)=PAER(:,:,IKRAD,:)
END DO
DO JSV=1,SIZE(PAER,4)
- TPROFILERS(JP)%XAER(IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), ZWORK2(:,:,:,JSV) )
+ TPROFILERS(JP)%XAER(:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZWORK2(:,:,:,JSV) )
END DO
- IF (SIZE(PTKE)>0) TPROFILERS(JP)%XTKE (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PTKE )
+ IF (SIZE(PTKE)>0) TPROFILERS(JP)%XTKE (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTKE )
+
+ ! XRHOD_SENSOR is not computed for profilers because not very useful
+ ! If needed, the interpolation must also be done vertically
+ ! (and therefore the vertical interpolation coefficients have to be computed)
+ ! TPROFILERS(JP)%XRHOD_SENSOR(IN) = ...
+
+ IF ( CRAD /= 'NONE' ) TPROFILERS(JP)%XTSRAD(IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTS )
!
- IF (LDIAG_IN_RUN) THEN
- TPROFILERS(JP)%XT2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_T2M )
- TPROFILERS(JP)%XQ2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_Q2M )
- TPROFILERS(JP)%XHU2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_HU2M )
- TPROFILERS(JP)%XZON10M(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_ZON10M )
- TPROFILERS(JP)%XMER10M(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_MER10M )
- TPROFILERS(JP)%XRN (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_RN )
- TPROFILERS(JP)%XH (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_H )
- TPROFILERS(JP)%XLE (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LE )
- TPROFILERS(JP)%XLEI (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LEI )
- TPROFILERS(JP)%XGFLUX (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_GFLUX )
- IF (CRAD /= 'NONE') THEN
- TPROFILERS(JP)%XSWD (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWD )
- TPROFILERS(JP)%XSWU (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWU )
- TPROFILERS(JP)%XLWD (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LWD )
- TPROFILERS(JP)%XLWU (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LWU )
- END IF
- TPROFILERS(JP)%XTKE_DISS(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), XCURRENT_TKE_DISS )
- END IF
+ IF ( LDIAG_SURFRAD_PROF ) CALL STATPROF_DIAG_SURFRAD(TPROFILERS(JP), IN )
+ TPROFILERS(JP)%XTKE_DISS(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( XCURRENT_TKE_DISS )
END DO PROFILER
!
!----------------------------------------------------------------------------
diff --git a/ext/read_all_data_grib_case.f90 b/ext/read_all_data_grib_case.f90
index eec912f59b18bf5c7e0a2a137a3136a38264955c..af2db5f9e53eeb8e755fc5435f1ae6a45c98a6e9 100644
--- a/ext/read_all_data_grib_case.f90
+++ b/ext/read_all_data_grib_case.f90
@@ -713,6 +713,10 @@ DEALLOCATE (ZLNPS_G)
!
WRITE (ILUOUT0,'(A)') ' | Reading T and Q fields'
!
+IF (IMODEL==11) THEN
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=130,KLEV1=1000) !look for air temperature at pressure level 1000hPa
+ IF (INUM < 0) IMODEL = 0 ! This change is for handling IFS model level grib file obtained by python API
+END IF
IF (IMODEL/=10.AND.IMODEL/=11) THEN
SELECT CASE (IMODEL)
CASE(0) ! ECMWF
diff --git a/ext/read_desfmn.f90 b/ext/read_desfmn.f90
index b65cce7aaf57610c6eac1e4d383bc036497b137b..39e599098f7401789fea437b2d6539906d08f4f1 100644
--- a/ext/read_desfmn.f90
+++ b/ext/read_desfmn.f90
@@ -266,8 +266,6 @@ USE MODN_LATZ_EDFLX
USE MODN_2D_FRC
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
-USE MODN_PROFILER_n
-USE MODN_STATION_n
!
! USE MODN_FLYERS
!
@@ -342,6 +340,7 @@ LOGICAL :: GFOUND ! Return code when searching namelist
LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_DST ! Dust Moist flag
LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_SLT ! Sea Salt Moist flag
LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_AER ! Orilam Moist flag
+TYPE(TFILEDATA), POINTER :: TZDESFILE
!
!-------------------------------------------------------------------------------
!
@@ -353,136 +352,139 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_DESFM_n','called for '//TRIM(TPDATAFILE%CN
IF (.NOT.ASSOCIATED(TPDATAFILE%TDESFILE)) &
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_DESFM_n','TDESFILE not associated for '//TRIM(TPDATAFILE%CNAME))
!
-ILUDES = TPDATAFILE%TDESFILE%NLU
+TZDESFILE => TPDATAFILE%TDESFILE
+ILUDES = TZDESFILE%NLU
ILUOUT = TLUOUT%NLU
!
-CALL POSNAM(ILUDES,'NAM_LUNITN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_LUNITN', GFOUND )
CALL INIT_NAM_LUNITN
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_LUNITn)
CALL UPDATE_NAM_LUNITN
END IF
-CALL POSNAM(ILUDES,'NAM_CONFN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_CONFN', GFOUND )
CALL INIT_NAM_CONFN
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_CONFn)
CALL UPDATE_NAM_CONFN
END IF
-CALL POSNAM(ILUDES,'NAM_DYNN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_DYNN', GFOUND )
CALL INIT_NAM_DYNN
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_DYNn)
CALL UPDATE_NAM_DYNN
END IF
-CALL POSNAM(ILUDES,'NAM_ADVN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_ADVN', GFOUND )
CALL INIT_NAM_ADVN
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_ADVn)
CALL UPDATE_NAM_ADVN
END IF
-CALL POSNAM(ILUDES,'NAM_PARAMN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_PARAMN', GFOUND )
CALL INIT_NAM_PARAMn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_PARAMn)
CALL UPDATE_NAM_PARAMn
END IF
-CALL POSNAM(ILUDES,'NAM_PARAM_RADN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_RADN', GFOUND )
CALL INIT_NAM_PARAM_RADn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_PARAM_RADn)
CALL UPDATE_NAM_PARAM_RADn
END IF
#ifdef MNH_ECRAD
-CALL POSNAM(ILUDES,'NAM_PARAM_ECRADN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_ECRADN', GFOUND )
CALL INIT_NAM_PARAM_ECRADn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_PARAM_ECRADn)
CALL UPDATE_NAM_PARAM_ECRADn
END IF
#endif
-CALL POSNAM(ILUDES,'NAM_PARAM_KAFRN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_KAFRN', GFOUND )
CALL INIT_NAM_PARAM_KAFRn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_PARAM_KAFRn)
CALL UPDATE_NAM_PARAM_KAFRn
END IF
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUDES,'NAM_LBCN',GFOUND)
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TZDESFILE, 'NAM_LBCN', GFOUND )
CALL INIT_NAM_LBCn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_LBCn)
CALL UPDATE_NAM_LBCn
END IF
-CALL POSNAM(ILUDES,'NAM_NUDGINGN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_NUDGINGN', GFOUND )
CALL INIT_NAM_NUDGINGn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_NUDGINGn)
CALL UPDATE_NAM_NUDGINGn
END IF
-CALL TURBN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL NEBN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL PARAM_ICEN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUDES,'NAM_CH_MNHCN',GFOUND)
+CALL TURBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL NEBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL PARAM_ICEN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TZDESFILE, 'NAM_CH_MNHCN', GFOUND )
CALL INIT_NAM_CH_MNHCn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_CH_MNHCn)
CALL UPDATE_NAM_CH_MNHCn
END IF
-CALL POSNAM(ILUDES,'NAM_CH_SOLVERN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_CH_SOLVERN', GFOUND )
CALL INIT_NAM_CH_SOLVERn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_CH_SOLVERn)
CALL UPDATE_NAM_CH_SOLVERn
END IF
-CALL POSNAM(ILUDES,'NAM_DRAGN',GFOUND)
+CALL POSNAM( TZDESFILE, 'NAM_DRAGN', GFOUND )
CALL INIT_NAM_DRAGn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_DRAGn)
CALL UPDATE_NAM_DRAGn
END IF
-CALL POSNAM(ILUDES,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_IBM_PARAMN', GFOUND )
CALL INIT_NAM_IBM_PARAMn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_IBM_PARAMn)
CALL UPDATE_NAM_IBM_PARAMn
END IF
-CALL POSNAM(ILUDES,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_RECYCL_PARAMN', GFOUND )
CALL INIT_NAM_RECYCL_PARAMn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_RECYCL_PARAMn)
CALL UPDATE_NAM_RECYCL_PARAMn
END IF
-CALL POSNAM(ILUDES,'NAM_SERIESN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_SERIESN', GFOUND )
CALL INIT_NAM_SERIESn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_SERIESn)
CALL UPDATE_NAM_SERIESn
END IF
-CALL POSNAM(ILUDES,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_BLOWSNOWN', GFOUND )
CALL INIT_NAM_BLOWSNOWn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_BLOWSNOWn)
CALL UPDATE_NAM_BLOWSNOWn
END IF
-CALL POSNAM(ILUDES,'NAM_BLANKN',GFOUND,ILUOUT)
+CALL POSNAM( TZDESFILE, 'NAM_BLANKN', GFOUND )
CALL INIT_NAM_BLANKn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_BLANKn)
CALL UPDATE_NAM_BLANKn
END IF
-CALL POSNAM(ILUDES,'NAM_PROFILERN',GFOUND,ILUOUT)
-CALL INIT_NAM_PROFILERn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_PROFILERN)
- CALL UPDATE_NAM_PROFILERn
-END IF
-CALL POSNAM(ILUDES,'NAM_STATIONN',GFOUND,ILUOUT)
-CALL INIT_NAM_STATIONn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_STATIONn)
- CALL UPDATE_NAM_STATIONn
-END IF
-CALL POSNAM(ILUDES,'NAM_FIREN',GFOUND,ILUOUT)
+! Note: it is not useful to read the PROFILERS/STATIONS namelists in the .des files
+! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! CALL POSNAM( TZDESFILE, 'NAM_PROFILERN', GFOUND )
+! CALL INIT_NAM_PROFILERn
+! IF (GFOUND) THEN
+! READ(UNIT=ILUDES,NML=NAM_PROFILERN)
+! CALL UPDATE_NAM_PROFILERn
+! END IF
+! CALL POSNAM( TZDESFILE, 'NAM_STATIONN', GFOUND )
+! CALL INIT_NAM_STATIONn
+! IF (GFOUND) THEN
+! READ(UNIT=ILUDES,NML=NAM_STATIONn)
+! CALL UPDATE_NAM_STATIONn
+! END IF
+CALL POSNAM( TZDESFILE, 'NAM_FIREN', GFOUND )
CALL INIT_NAM_FIREn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_FIREn)
@@ -491,13 +493,13 @@ END IF
!
!
IF (KMI == 1) THEN
- CALL POSNAM(ILUDES,'NAM_CONF',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_CONF', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONF)
- CALL POSNAM(ILUDES,'NAM_DYN',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_DYN', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DYN)
- CALL POSNAM(ILUDES,'NAM_NESTING',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_NESTING', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_NESTING)
- CALL POSNAM(ILUDES,'NAM_BACKUP',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_BACKUP', GFOUND )
IF (GFOUND) THEN
IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
@@ -521,10 +523,10 @@ IF (KMI == 1) THEN
END IF
READ(UNIT=ILUDES,NML=NAM_BACKUP)
ELSE
- CALL POSNAM(ILUDES,'NAM_FMOUT',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_FMOUT', GFOUND )
IF (GFOUND) CALL PRINT_MSG(NVERB_FATAL,'IO','READ_DESFM_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
END IF
- CALL POSNAM(ILUDES,'NAM_OUTPUT',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_OUTPUT', GFOUND )
IF (GFOUND) THEN
IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) !Allocate *BAK* variables to prevent
@@ -550,83 +552,83 @@ IF (KMI == 1) THEN
END IF
! Note: it is not useful to read the budget namelists in the .des files
! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
-! CALL POSNAM(ILUDES,'NAM_BUDGET',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BUDGET', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BUDGET)
-! CALL POSNAM(ILUDES,'NAM_BU_RU',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RU', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RU)
-! CALL POSNAM(ILUDES,'NAM_BU_RV',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RV', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RV)
-! CALL POSNAM(ILUDES,'NAM_BU_RW',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RW', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RW)
-! CALL POSNAM(ILUDES,'NAM_BU_RTH',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RTH', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTH)
-! CALL POSNAM(ILUDES,'NAM_BU_RTKE',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RTKE', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTKE)
-! CALL POSNAM(ILUDES,'NAM_BU_RRV',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRV', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRV)
-! CALL POSNAM(ILUDES,'NAM_BU_RRC',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRC', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRC)
-! CALL POSNAM(ILUDES,'NAM_BU_RRR',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRR', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRR)
-! CALL POSNAM(ILUDES,'NAM_BU_RRI',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRI', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRI)
-! CALL POSNAM(ILUDES,'NAM_BU_RRS',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRS', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRS)
-! CALL POSNAM(ILUDES,'NAM_BU_RRG',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRG', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRG)
-! CALL POSNAM(ILUDES,'NAM_BU_RRH',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRH', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRH)
-! CALL POSNAM(ILUDES,'NAM_BU_RSV',GFOUND)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RSV', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RSV)
- CALL POSNAM(ILUDES,'NAM_LES',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_LES', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LES)
- CALL POSNAM(ILUDES,'NAM_PDF',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_PDF', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PDF)
- CALL POSNAM(ILUDES,'NAM_FRC',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_FRC', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FRC)
- CALL POSNAM(ILUDES,'NAM_PARAM_C2R2',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_PARAM_C2R2', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PARAM_C2R2)
- CALL POSNAM(ILUDES,'NAM_PARAM_C1R3',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_PARAM_C1R3', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PARAM_C1R3)
- CALL PARAM_LIMA_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
- CALL POSNAM(ILUDES,'NAM_ELEC',GFOUND)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+ CALL POSNAM( TZDESFILE, 'NAM_ELEC', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_ELEC)
- CALL POSNAM(ILUDES,'NAM_SERIES',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_SERIES', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SERIES)
- CALL POSNAM(ILUDES,'NAM_TURB_CLOUD',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_TURB_CLOUD', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_TURB_CLOUD)
- CALL POSNAM(ILUDES,'NAM_CH_ORILAM',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_CH_ORILAM', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CH_ORILAM)
- CALL POSNAM(ILUDES,'NAM_DUST',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_DUST', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DUST)
- CALL POSNAM(ILUDES,'NAM_SALT',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_SALT', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SALT)
- CALL POSNAM(ILUDES,'NAM_PASPOL',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_PASPOL', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PASPOL)
#ifdef MNH_FOREFIRE
- CALL POSNAM(ILUDES,'NAM_FOREFIRE',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_FOREFIRE', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FOREFIRE)
#endif
- CALL POSNAM(ILUDES,'NAM_CONDSAMP',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_CONDSAMP', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONDSAMP)
- CALL POSNAM(ILUDES,'NAM_BLOWSNOW',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_BLOWSNOW', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BLOWSNOW)
- CALL POSNAM(ILUDES,'NAM_2D_FRC',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_2D_FRC', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_2D_FRC)
LTEMPDEPOS_DST(:) = LDEPOS_DST(:)
LTEMPDEPOS_SLT(:) = LDEPOS_SLT(:)
LTEMPDEPOS_AER(:) = LDEPOS_AER(:)
- CALL POSNAM(ILUDES,'NAM_LATZ_EDFLX',GFOUND)
+ CALL POSNAM( TZDESFILE, 'NAM_LATZ_EDFLX', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LATZ_EDFLX)
- CALL POSNAM(ILUDES,'NAM_VISC',GFOUND,ILUOUT)
+ CALL POSNAM( TZDESFILE, 'NAM_VISC', GFOUND )
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_VISC)
! Note: it is not useful to read the FLYERS/AIRCRAFTS/BALLOONS namelists in the .des files
! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
-! CALL POSNAM(ILUDES,'NAM_FLYERS',GFOUND,ILUOUT)
+! CALL POSNAM( TZDESFILE, 'NAM_FLYERS', GFOUND )
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FLYERS)
-! CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
+! CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS', GFOUND )
! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
-! CALL POSNAM(ILUSEG,'NAM_BALLOONS',GFOUND,ILUOUT)
+! CALL POSNAM(ILUSEG,'NAM_BALLOONS', GFOUND )
! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
END IF
!
@@ -716,16 +718,16 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,NML=NAM_PARAM_KAFRn)
!
WRITE(UNIT=ILUOUT,FMT="('*** MASS FLUX SHALLOW CONVECTION ***')")
- CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_MFSHALLN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** LBCn ********************')")
WRITE(UNIT=ILUOUT,NML=NAM_LBCn)
!
WRITE(UNIT=ILUOUT,FMT="('********** TURBn *******************')")
- CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL TURBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** NEBn *******************')")
- CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL NEBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** DRAGn *******************')")
WRITE(UNIT=ILUOUT,NML=NAM_DRAGn)
@@ -751,14 +753,15 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,FMT="('********** BLANKn ******************')")
WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
!
- WRITE(UNIT=ILUOUT,FMT="('********** PROFILERn *****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PROFILERn)
+! Profilers/stations namelists not read anymore in READ_DESFM_n
+! WRITE(UNIT=ILUOUT,FMT="('********** PROFILERn *****************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_PROFILERn)
!
- WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
+! WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
!
WRITE(UNIT=ILUOUT,FMT="('************ ICE SCHEME ***********************')")
- CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_ICEN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** BLAZE *******************')")
WRITE(UNIT=ILUOUT,NML=NAM_FIREn)
@@ -870,7 +873,7 @@ IF (NVERB >= 10) THEN
!
IF( CCLOUD == 'LIMA' ) THEN
WRITE(UNIT=ILUOUT,FMT="('************ LIMA SCHEME **********************')")
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
END IF
!
IF (CELEC /= 'NONE') THEN
diff --git a/ext/read_exsegn.f90 b/ext/read_exsegn.f90
index dfb02a2dc0931de75a7fef446a8576081aa97087..1aa20763f3e5f7718a35250692619d1555dc8b76 100644
--- a/ext/read_exsegn.f90
+++ b/ext/read_exsegn.f90
@@ -304,6 +304,7 @@ END MODULE MODI_READ_EXSEG_n
! R. Honnert 23/04/2021: add HM21 mixing length and delete HRIO and BOUT from CMF_UPDRAFT
! S. Riette 11/05/2021 HighLow cloud
! A. Costes 12/2021: add Blaze fire model
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
! P. Wautelet 27/04/2022: add namelist for profilers
! P. Wautelet 24/06/2022: remove check on CSTORAGE_TYPE for restart of ForeFire variables
! P. Wautelet 13/07/2022: add namelist for flyers and balloons
@@ -319,6 +320,7 @@ USE MODD_CH_AEROSOL
USE MODD_CH_M9_n, ONLY : NEQ
USE MODD_CONDSAMP
USE MODD_CONF
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_CONFZ
! USE MODD_DRAG_n
USE MODD_DUST
@@ -361,6 +363,7 @@ USE MODN_CONF
USE MODN_CONF_n
USE MODN_CONFZ
USE MODN_DRAGBLDG_n
+USE MODN_COUPLING_LEVELS_n
USE MODN_DRAG_n
USE MODN_DRAGTREE_n
USE MODN_DUST
@@ -401,12 +404,12 @@ USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
USE MODN_PARAM_n ! realized in subroutine ini_model n
USE MODN_PARAM_RAD_n
USE MODN_PASPOL
-USE MODN_PROFILER_n
+USE MODN_PROFILER_n, LDIAG_SURFRAD_PROF => LDIAG_SURFRAD
USE MODN_RECYCL_PARAM_n
USE MODN_SALT
USE MODN_SERIES
USE MODN_SERIES_n
-USE MODN_STATION_n
+USE MODN_STATION_n, LDIAG_SURFRAD_STAT => LDIAG_SURFRAD
USE MODD_TURB_n, ONLY: TURBN_INIT, CTOM, CTURBDIM, LRMC01, LHARAT, &
LCLOUDMODIFLM, CTURBLEN_CLOUD, XCEI_MIN, XCEI_MAX
USE MODD_NEB_n, ONLY: NEBN_INIT, LSIGMAS, LSUBG_COND, CCONDENS, LSTATNW
@@ -492,6 +495,7 @@ CALL INIT_NAM_DYNN
CALL INIT_NAM_ADVN
CALL INIT_NAM_DRAGTREEN
CALL INIT_NAM_DRAGBLDGN
+CALL INIT_NAM_COUPLING_LEVELSN
CALL INIT_NAM_PARAMN
CALL INIT_NAM_PARAM_RADN
#ifdef MNH_ECRAD
@@ -513,76 +517,78 @@ CALL INIT_NAM_STATIONn
CALL INIT_NAM_FIREn
!
WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
-CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_LUNITN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LUNITn)
-CALL POSNAM(ILUSEG,'NAM_CONFN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CONFN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFn)
-CALL POSNAM(ILUSEG,'NAM_DYNN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DYNN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYNn)
-CALL POSNAM(ILUSEG,'NAM_ADVN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_ADVN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ADVn)
-CALL POSNAM(ILUSEG,'NAM_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAMN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_PARAM_RADN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_RADN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_RADn)
#ifdef MNH_ECRAD
-CALL POSNAM(ILUSEG,'NAM_PARAM_ECRADN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_ECRADN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn)
#endif
-CALL POSNAM(ILUSEG,'NAM_PARAM_KAFRN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_KAFRN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUSEG,'NAM_LBCN',GFOUND,ILUOUT)
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TPEXSEGFILE, 'NAM_LBCN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LBCn)
-CALL POSNAM(ILUSEG,'NAM_NUDGINGN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_NUDGINGN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NUDGINGn)
-CALL TURBN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL NEBN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL PARAM_ICEN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT)
+CALL TURBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL NEBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL PARAM_ICEN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
-CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_IBM_PARAMN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_RECYCL_PARAMN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CH_MNHCN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
-CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CH_SOLVERN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
-CALL POSNAM(ILUSEG,'NAM_SERIESN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_SERIESN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn)
-CALL POSNAM(ILUSEG,'NAM_BLANKN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_BLANKN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANKn)
-CALL POSNAM(ILUSEG,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_BLOWSNOWN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
-CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGTREEN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
-CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGBLDGN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
-CALL POSNAM(ILUSEG,'NAM_EOL',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE,'NAM_COUPLING_LEVELSN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_COUPLING_LEVELSn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL)
-CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL_ADNR', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
-CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL_ALM', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
-CALL POSNAM(ILUSEG,'NAM_PROFILERN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PROFILERN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PROFILERn)
-CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_STATIONN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
-CALL POSNAM(ILUSEG,'NAM_FIREN',GFOUND,ILUOUT)
+CALL POSNAM( TPEXSEGFILE, 'NAM_FIREN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FIREn)
!
IF (KMI == 1) THEN
WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
- CALL POSNAM(ILUSEG,'NAM_CONF',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONF', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONF)
- CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONFZ', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
- CALL POSNAM(ILUSEG,'NAM_DYN',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_DYN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYN)
- CALL POSNAM(ILUSEG,'NAM_NESTING',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_NESTING', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NESTING)
- CALL POSNAM(ILUSEG,'NAM_BACKUP',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BACKUP', GFOUND )
IF (GFOUND) THEN
!Should have been allocated before in READ_DESFM_n
IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
@@ -607,14 +613,14 @@ IF (KMI == 1) THEN
END IF
READ(UNIT=ILUSEG,NML=NAM_BACKUP)
ELSE
- CALL POSNAM(ILUSEG,'NAM_FMOUT',GFOUND)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FMOUT', GFOUND )
IF (GFOUND) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_EXSEG_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
ELSE
IF (CPROGRAM=='MESONH') CALL PRINT_MSG(NVERB_ERROR,'IO','READ_EXSEG_n','namelist NAM_BACKUP not found')
END IF
END IF
- CALL POSNAM(ILUSEG,'NAM_OUTPUT',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_OUTPUT', GFOUND )
IF (GFOUND) THEN
!Should have been allocated before in READ_DESFM_n
IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
@@ -639,10 +645,10 @@ IF (KMI == 1) THEN
END IF
READ(UNIT=ILUSEG,NML=NAM_OUTPUT)
END IF
- CALL POSNAM(ILUSEG,'NAM_BUDGET',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BUDGET', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BUDGET)
- CALL POSNAM(ILUSEG,'NAM_BU_RU',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RU', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RU ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RU was already allocated' )
@@ -655,7 +661,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RV',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RV', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RV ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RV was already allocated' )
@@ -668,7 +674,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RW',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RW', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RW ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RW was already allocated' )
@@ -681,7 +687,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RTH',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RTH', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RTH ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTH was already allocated' )
@@ -694,7 +700,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RTKE',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RTKE', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RTKE ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTKE was already allocated' )
@@ -707,7 +713,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRV',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRV', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRV ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRV was already allocated' )
@@ -720,7 +726,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRC',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRC', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRC ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRC was already allocated' )
@@ -733,7 +739,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRR',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRR', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRR ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRR was already allocated' )
@@ -746,7 +752,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRI',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRI', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRI ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRI was already allocated' )
@@ -759,7 +765,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRS',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRS', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRS ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRS was already allocated' )
@@ -772,7 +778,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRG',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRG', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRG ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRG was already allocated' )
@@ -785,7 +791,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RRH',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRH', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RRH ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRH was already allocated' )
@@ -798,7 +804,7 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_BU_RSV',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RSV', GFOUND )
IF (GFOUND) THEN
IF ( ALLOCATED( CBULIST_RSV ) ) THEN
CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RSV was already allocated' )
@@ -811,58 +817,58 @@ IF (KMI == 1) THEN
ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
END IF
- CALL POSNAM(ILUSEG,'NAM_LES',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_LES', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LES)
- CALL POSNAM(ILUSEG,'NAM_MEAN',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_MEAN', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_MEAN)
- CALL POSNAM(ILUSEG,'NAM_PDF',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PDF', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PDF)
- CALL POSNAM(ILUSEG,'NAM_FRC',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FRC', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FRC)
- CALL POSNAM(ILUSEG,'NAM_PARAM_C2R2',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_C2R2', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
- CALL POSNAM(ILUSEG,'NAM_PARAM_C1R3',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_C1R3', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
- CALL PARAM_LIMA_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
- CALL POSNAM(ILUSEG,'NAM_ELEC',GFOUND,ILUOUT)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_ELEC', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ELEC)
- CALL POSNAM(ILUSEG,'NAM_SERIES',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_SERIES', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIES)
- CALL POSNAM(ILUSEG,'NAM_CH_ORILAM',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CH_ORILAM', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
- CALL POSNAM(ILUSEG,'NAM_DUST',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_DUST', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DUST)
- CALL POSNAM(ILUSEG,'NAM_SALT',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_SALT', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SALT)
- CALL POSNAM(ILUSEG,'NAM_PASPOL',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PASPOL', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PASPOL)
#ifdef MNH_FOREFIRE
- CALL POSNAM(ILUSEG,'NAM_FOREFIRE',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FOREFIRE', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FOREFIRE)
#endif
- CALL POSNAM(ILUSEG,'NAM_CONDSAMP',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONDSAMP', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP)
- CALL POSNAM(ILUSEG,'NAM_2D_FRC',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_2D_FRC', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
- CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_LATZ_EDFLX', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
- CALL POSNAM(ILUSEG,'NAM_BLOWSNOW',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BLOWSNOW', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
- CALL POSNAM(ILUSEG,'NAM_VISC',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_VISC', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_VISC)
- CALL POSNAM(ILUSEG,'NAM_FLYERS',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FLYERS', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FLYERS)
IF ( NAIRCRAFTS > 0 ) THEN
CALL AIRCRAFTS_NML_ALLOCATE( NAIRCRAFTS )
- CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_AIRCRAFTS', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
END IF
IF ( NBALLOONS > 0 ) THEN
CALL BALLOONS_NML_ALLOCATE( NBALLOONS )
- CALL POSNAM(ILUSEG,'NAM_BALLOONS',GFOUND,ILUOUT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BALLOONS', GFOUND )
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
END IF
END IF
@@ -907,8 +913,8 @@ CALL TEST_NAM_VAR(ILUOUT,'CLBCX(2)',CLBCX(2),'CYCL','WALL','OPEN')
CALL TEST_NAM_VAR(ILUOUT,'CLBCY(1)',CLBCY(1),'CYCL','WALL','OPEN')
CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN')
!
-CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL TURBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL NEBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
!
CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
'SPLIT ','CENTER ','LAGGED ')
@@ -927,11 +933,11 @@ CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN_CLOUD',CTURBLEN_CLOUD,'NONE','DEAR','DELT','B
!
! The test on the mass flux scheme for shallow convection
!
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
!
! The test on the CSOLVER name is made elsewhere
!
-CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL PARAM_ICEN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
IF( CCLOUD == 'C3R5' ) THEN
CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_C1R3',CPRISTINE_ICE_C1R3, &
'PLAT','COLU','BURO')
@@ -940,7 +946,7 @@ IF( CCLOUD == 'C3R5' ) THEN
END IF
!
IF( CCLOUD == 'LIMA' ) THEN
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
END IF
! Blaze
CALL UPDATE_NAM_FIREn
@@ -2994,6 +3000,7 @@ CALL UPDATE_NAM_LUNITN
CALL UPDATE_NAM_CONFN
CALL UPDATE_NAM_DRAGTREEN
CALL UPDATE_NAM_DRAGBLDGN
+CALL UPDATE_NAM_COUPLING_LEVELSN
CALL UPDATE_NAM_DYNN
CALL UPDATE_NAM_ADVN
CALL UPDATE_NAM_PARAMN
diff --git a/ext/write_desfmn.f90 b/ext/write_desfmn.f90
index d5ee56097423c4e106b08d9387980c0b063c2f27..908c2eff83a767d24cddf6d5c7b1aebdb7f589ea 100644
--- a/ext/write_desfmn.f90
+++ b/ext/write_desfmn.f90
@@ -216,8 +216,8 @@ USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
USE MODN_IBM_PARAM_n
USE MODN_RECYCL_PARAM_n
-USE MODN_PROFILER_n
-USE MODN_STATION_n
+USE MODN_PROFILER_n, LDIAG_SURFRAD_PROF => LDIAG_SURFRAD
+USE MODN_STATION_n, LDIAG_SURFRAD_STAT => LDIAG_SURFRAD
USE MODN_FIRE_n
USE MODN_FLYERS
!
@@ -367,7 +367,7 @@ CALL INIT_NAM_PARAM_KAFRn
IF(CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') &
WRITE(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
!
-IF (CSCONV == 'EDKF' ) CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF (CSCONV == 'EDKF' ) CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
!
CALL INIT_NAM_LBCn
WRITE(UNIT=ILUSEG,NML=NAM_LBCn)
@@ -375,9 +375,9 @@ WRITE(UNIT=ILUSEG,NML=NAM_LBCn)
CALL INIT_NAM_NUDGINGn
WRITE(UNIT=ILUSEG,NML=NAM_NUDGINGn)
!
-IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
!
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
!
CALL INIT_NAM_BLANKn
WRITE(UNIT=ILUSEG,NML=NAM_BLANKn)
@@ -457,15 +457,15 @@ IF(LBU_RSV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RSV)
IF(LLES_MEAN .OR. LLES_RESOLVED .OR. LLES_SUBGRID .OR. LLES_UPDRAFT &
.OR. LLES_DOWNDRAFT .OR. LLES_SPECTRA) WRITE(UNIT=ILUSEG,NML=NAM_LES)
IF(LFORCING .OR. LTRANS) WRITE(UNIT=ILUSEG,NML=NAM_FRC)
-IF(CCLOUD(1:3) == 'ICE') CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CCLOUD(1:3) == 'ICE') CALL PARAM_ICEN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
IF(CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') &
WRITE(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
IF(CCLOUD == 'C3R5' ) WRITE(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
-IF(CCLOUD == 'LIMA' ) CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CCLOUD == 'LIMA' ) CALL PARAM_LIMA_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
IF(CELEC /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_ELEC)
IF(LSERIES) WRITE(UNIT=ILUSEG,NML=NAM_SERIES)
-IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
WRITE(UNIT=ILUSEG,NML=NAM_FLYERS)
!Not possible (for the moment): arrays have been deallocated after ini_aircraft: WRITE(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
!Not possible (for the moment): arrays have been deallocated after ini_balloon: WRITE(UNIT=ILUSEG,NML=NAM_BALLOONS)
@@ -521,7 +521,7 @@ IF (NVERB >= 5) THEN
WRITE(UNIT=ILUOUT,NML=NAM_PARAM_KAFRn)
!
WRITE(UNIT=ILUOUT,FMT="('************ PARAM_MFSHALLn *******')")
- CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** LBCn ********************')")
WRITE(UNIT=ILUOUT,NML=NAM_LBCn)
@@ -530,10 +530,10 @@ IF (NVERB >= 5) THEN
WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
!
WRITE(UNIT=ILUOUT,FMT="('********** TURBn *******************')")
- CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** NEBn *******************')")
- CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL MONITORn *******')")
WRITE(UNIT=ILUOUT,NML=NAM_CH_MNHCn)
@@ -554,7 +554,7 @@ IF (NVERB >= 5) THEN
WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
!
WRITE(UNIT=ILUOUT,FMT="('************ ICE SCHEME ***********************')")
- CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_ICEN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
!
IF (KMI==1) THEN
WRITE(UNIT=ILUOUT,FMT="(/,'PART OF SEGMENT FILE COMMON TO ALL THE MODELS')")
@@ -671,7 +671,7 @@ IF (NVERB >= 5) THEN
!
IF( CCLOUD == 'LIMA' ) THEN
WRITE(UNIT=ILUOUT,FMT="('*********** LIMA SCHEME *********************')")
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
END IF
!
IF( CCLOUD == 'KHKO' ) THEN
diff --git a/ext/write_lfifm1_for_diag.f90 b/ext/write_lfifm1_for_diag.f90
index a6099e6a0f4eb779347699adbcf1e6f85fc896ca..84ff78bdab8ce9d1759df3baa7a02dc307bd0382 100644
--- a/ext/write_lfifm1_for_diag.f90
+++ b/ext/write_lfifm1_for_diag.f90
@@ -1087,7 +1087,6 @@ IF (LLIMA_DIAG) THEN
END IF
!
DO JSV = NSV_LIMA_BEG,NSV_LIMA_END
-!PW: bases sur CLIMA_*_CONC et pas CLIMA_*_NAMES !!!
!
TZFIELD%CUNITS = 'cm-3'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
@@ -1194,7 +1193,6 @@ IF (LLIMA_DIAG) THEN
END IF
!
END IF
-!PW: TODO: a documenter
IF (LELECDIAG .AND. CELEC .NE. "NONE") THEN
DO JSV = NSV_ELECBEG,NSV_ELECEND
TZFIELD = TSVLIST(JSV)
@@ -1279,7 +1277,6 @@ IF (LPASPOL) THEN
END IF
! Conditional sampling variables
IF (LCONDSAMP) THEN
-!PW: TODO: a documenter!!!
DO JSV = NSV_CSBEG, NSV_CSEND
TZFIELD = TSVLIST(JSV)
CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
@@ -1319,7 +1316,6 @@ IF (LCHAQDIAG) THEN !aqueous concentration in M
-!PW: TODO: LCHICDIAG n'existe pas => les variables correspondantes ne sont pas ecrites...
! ZWORK31(:,:,:)=0.
! DO JSV = NSV_CHICBEG,NSV_CHICEND ! ice phase
@@ -1348,8 +1344,26 @@ IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN
IF (.NOT.(ASSOCIATED(XSIG3D))) &
ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
!
- CALL PPP2AERO(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF, &
- PSIG3D=XSIG3D, PRG3D=XRG3D, PN3D=XN3D, PCTOTA=ZPTOTA)
+ IF (CRGUNIT=="MASS") THEN
+ XRG3D(:,:,:,1) = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2)
+ XRG3D(:,:,:,2) = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2)
+ ELSE
+ XRG3D(:,:,:,1) = XINIRADIUSI
+ XRG3D(:,:,:,2) = XINIRADIUSJ
+ END IF
+ XSIG3D(:,:,:,1) = XINISIGI
+ XSIG3D(:,:,:,2) = XINISIGJ
+ XN3D(:,:,:,1) = XN0IMIN
+ XN3D(:,:,:,2) = XN0JMIN
+
+ ZPTOTA(:,:,:,:,:) = 0.
+
+ CALL PPP2AERO(XSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND),&
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PSIG3D=XSIG3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PRG3D=XRG3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PN3D=XN3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PCTOTA=ZPTOTA(IIB:IIE,IJB:IJE,IKB:IKE,:,:))
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'generic for aerosol modes', &
@@ -1868,7 +1882,6 @@ END IF
! Blowing snow variables
!
IF(LBLOWSNOW) THEN
-!PW:TODO?:variables scalaires XSVT pas ecrites ici. Voulu?
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'SNWSUBL3D', &
CSTDNAME = '', &
diff --git a/ext/write_lfifm1_for_diag_supp.f90 b/ext/write_lfifm1_for_diag_supp.f90
index bb8214c93eb61a4b10f68adc4f90d12f6d43773f..380dc9fd629a10d16c344098535ea0a109226bd3 100644
--- a/ext/write_lfifm1_for_diag_supp.f90
+++ b/ext/write_lfifm1_for_diag_supp.f90
@@ -91,6 +91,9 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! J.-P. Chaboureau 07/2018 bug fix on XEMIS when calling CALL_RTTOVxx
!! J.-P. Chaboureau 09/04/2021 add the call to RTTOV13
! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
+!! D. Ricard & Q.Rodier 08/2023 add some diagnostics on pressure levels
+!! (temperature, relative and specific humidity, vertical velocity, TKE)
+!! D. Ricard 08/2023 add a diagnostic: maximum of cloud fraction on vertical levels
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -100,7 +103,7 @@ USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_CH_BUDGET_n, ONLY: CNAMES_BUDGET, NEQ_BUDGET, XTCHEM
USE MODD_CH_FLX_n, ONLY: XCHFLX
USE MODD_CH_PRODLOSSTOT_n, ONLY: CNAMES_PRODLOSST, NEQ_PLT, XLOSS, XPROD
-USE MODD_CST, ONLY: XCPD, XP00, XRD, XTT
+USE MODD_CST, ONLY: XCPD, XP00, XRD, XTT, XMV, XMD, XALPI, XGAMI, XBETAI
USE MODD_CURVCOR_n, ONLY: XCORIOZ
USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_ZON10M, XCURRENT_MER10M, &
XCURRENT_SFCO2, XCURRENT_SWD, XCURRENT_LWD, &
@@ -111,7 +114,7 @@ use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, NMN
use modd_field
USE MODD_IO, ONLY: TFILEDATA
USE MODD_CONF, ONLY: LCARTESIAN
-USE MODD_CONF_n, ONLY: LUSERC, LUSERI, NRR
+USE MODD_CONF_n, ONLY: LUSERC, LUSERI, LUSERV, NRR
USE MODD_DEEP_CONVECTION_n, ONLY: NCLBASCONV, NCLTOPCONV, XCAPE, XDMFCONV, XDRCCONV, XDRICONV, XDRVCONV, &
XDTHCONV, XDSVCONV, XMFCONV, XPRLFLXCONV, XPRSFLXCONV, XUMFCONV
USE MODD_DIAG_FLAG, ONLY: CRAD_SAT, LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
@@ -123,7 +126,7 @@ USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
USE MODD_NSV, ONLY: NSV, NSV_CHEMBEG, NSV_CHEMEND, TSVLIST
USE MODD_PARAMETERS, ONLY: JPVEXT, NUNDEF, XUNDEF
USE MODD_PARAM_KAFR_n, ONLY: LCHTRANS
-USE MODD_PARAM_n, ONLY: CRAD, CSURF
+USE MODD_PARAM_n, ONLY: CRAD, CSURF, CCLOUD
USE MODD_PARAM_RAD_n, only: NRAD_COLNBR
USE MODD_RADIATIONS_N, ONLY: NCLEARCOL_TM1, NDLON, NFLEV, NSTATM, &
XAER, XAZIM, XCCO2, XDIR_ALB, XDIRFLASWD, XDIRSRFSWD, XDTHRAD, XEMIS, &
@@ -138,6 +141,7 @@ use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
USE MODE_NEIGHBORAVG, ONLY: BLOCKAVG, MOVINGAVG
+USE MODE_THERMO, ONLY: SM_FOES
USE MODE_TOOLS_LL, ONLY: GET_INDICE_ll
#ifdef MNH_RTTOV_8
@@ -172,7 +176,7 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
INTEGER :: IKRAD
!
-INTEGER :: JI,JJ,JK,JSV ! loop index
+INTEGER :: JI,JJ,JK,JSV,JRR ! loop index
!
! variables for Diagnostic variables related to deep convection
REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK21,ZWORK22
@@ -198,7 +202,8 @@ INTEGER :: IPRES, ITH
CHARACTER(LEN=4) :: YCAR4
CHARACTER(LEN=4), DIMENSION(SIZE(XISOPR)) :: YPRES
CHARACTER(LEN=4), DIMENSION(SIZE(XISOTH)) :: YTH
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH, &
+ ZRT,ZQV,ZMRVP,ZWRES1,ZTEMPP
REAL, DIMENSION(:), ALLOCATABLE :: ZTH
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPOVO
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ
@@ -434,6 +439,22 @@ IF (LCLD_COV .AND. LUSERC) THEN
CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR)
CALL IO_Field_write(TPFILE,'ICEFR',XICEFR)
!
+ ZWORK21(:,:)=0.0
+ ZWORK21(IIB:IIE,IJB:IJE)=MAXVAL(XCLDFR(IIB:IIE,IJB:IJE,JPVEXT+1:IKE),DIM=3)
+
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLDFRMAX', &
+ !Invalid CF convention standard name: CSTDNAME = 'max_cloud_fraction', &
+ CLONGNAME = 'CLDFRMAX', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_MAx of CLoud fraction', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ !
! Visibility
!
ZWORK31(:,:,:)= 1.E4 ! 10 km for clear sky
@@ -910,6 +931,7 @@ IF (CSURF=='EXTE') THEN
CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SFCO2)
END IF
!
+ IF ( CRAD /= 'NONE' ) THEN
IF(ANY(XCURRENT_SWD/=XUNDEF))THEN
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'SWD', &
@@ -969,6 +991,7 @@ IF (CSURF=='EXTE') THEN
LTIMEDEP = .TRUE. )
CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_LWU)
END IF
+ END IF ! CRAD/='NONE'
END IF
! MODIF FP NOV 2012
@@ -996,6 +1019,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
END DO
ALLOCATE(ZWRES(IIU,IJU,IPRES))
+ ALLOCATE(ZTEMPP(IIU,IJU,IPRES))
ZWRES(:,:,:)=XUNDEF
ALLOCATE(ZPRES(IIU,IJU,IPRES))
IPRES=0
@@ -1031,6 +1055,17 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
! *********************
+! Temperature
+! *********************
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'TEMP'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'K'
+ TZFIELD%CCOMMENT = 'X_Y_air temperature '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*(ZPRES(:,:,JK)/XP00)**(XRD/XCPD))
+ END DO
+ ZTEMPP(:,:,:)=ZWRES(:,:,:)
+! *********************
! Wind
! *********************
ZWORK31(:,:,:) = MXF(XUT(:,:,:))
@@ -1054,6 +1089,29 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
+ !
+ ZWORK31(:,:,:) = MZF(XWT(:,:,:))
+ CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'WT'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+! *********************
+! Turbulent kinetic energy
+! *********************
+ CALL PINTER(XTKET, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'TKET'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm 2 s-2'
+ TZFIELD%CCOMMENT = 'X_Y_turbulent kinetic energy '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
! *********************
! Water Vapour Mixing Ratio
! *********************
@@ -1066,6 +1124,55 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CCOMMENT = 'X_Y_Vapor Mixing Ratio '//TRIM(YPRES(JK))//' hPa'
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*1.E3)
END DO
+!
+! *********************
+! Relative humidity
+! *********************
+ IF (LUSERV) THEN
+ ALLOCATE(ZWRES1(IIU,IJU,IPRES))
+ ALLOCATE(ZMRVP(IIU,IJU,IPRES))
+ ZMRVP(:,:,:)=ZWRES(:,:,:)
+ ZWRES1(:,:,:)=SM_FOES(ZTEMPP(:,:,:))
+ ZWRES1(:,:,:)=(XMV/XMD)*ZWRES1(:,:,:)/(ZPRES(:,:,:)-ZWRES1(:,:,:))
+ ZWRES(:,:,:)=100.*ZMRVP(:,:,:)/ZWRES1(:,:,:)
+ IF (CCLOUD(1:3) =='ICE' .OR. CCLOUD =='C3R5' .OR. CCLOUD == 'LIMA') THEN
+ WHERE ( ZTEMPP(:,:,:)< XTT)
+ ZWRES1(:,:,:) = EXP( XALPI - XBETAI/ZTEMPP(:,:,:) &
+ - XGAMI*ALOG(ZTEMPP(:,:,:)) ) !saturation over ice
+ ZWRES1(:,:,:)=(XMV/XMD)*ZWRES1(:,:,:)/(ZPRES(:,:,:)-ZWRES1(:,:,:))
+ ZWRES(:,:,:)=100.*ZMRVP(:,:,:)/ZWRES1(:,:,:)
+ END WHERE
+ END IF
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'REHU'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'percent'
+ TZFIELD%CCOMMENT = 'X_Y_Relative humidity '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ DEALLOCATE(ZWRES1,ZMRVP,ZTEMPP)
+ END IF
+ !
+ ALLOCATE(ZRT(IIU,IJU,IKU))
+ ALLOCATE(ZQV(IIU,IJU,IKU))
+ ZRT(:,:,:)=0.
+ DO JRR=1,NRR
+ ZRT(:,:,:) = ZRT(:,:,:) + XRT(:,:,:,JRR)
+ END DO
+ ZQV(:,:,:) = XRT(:,:,:,1) / (1.0 + ZRT(:,:,:))
+ ! *********************
+ ! Water specific humidity
+ ! *********************
+ CALL PINTER(ZQV, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'QV'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Vapor Specific humidity '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ DEALLOCATE(ZRT,ZQV)
! *********************
! Geopotential in meters
! *********************
diff --git a/ext/xy_to_latlon.f90 b/ext/xy_to_latlon.f90
index 45a379940c45a11e46943cc0cd61895fb3ec97f6..9effbed461cfe363dbffd7da68038ce37bd3763e 100644
--- a/ext/xy_to_latlon.f90
+++ b/ext/xy_to_latlon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2023 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.
@@ -73,6 +73,7 @@ USE MODD_LUNIT
!
USE MODE_FIELD, ONLY: INI_FIELD_LIST
USE MODE_GRIDPROJ
+USE MODE_INIT_ll, only: SET_DIM_ll, SET_JP_ll
USE MODE_IO, only: IO_Config_set, IO_Init
use MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
diff --git a/ext/zoom_pgd.f90 b/ext/zoom_pgd.f90
index 8caa8ccb640fc9c5bfff4ff7353b87586c9586e8..2b50885c8b679b3940c28ef06825170ef5a02326 100644
--- a/ext/zoom_pgd.f90
+++ b/ext/zoom_pgd.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2005-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2023 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.
@@ -138,9 +138,9 @@ ILUNAM = TZNMLFILE%NLU
CPGDFILE = 'PGDFILE' ! name of the input file
YZOOMFILE = ''
YZOOMNBR = '00'
-CALL POSNAM(ILUNAM,'NAM_PGDFILE',GFOUND,ILUOUT0)
+CALL POSNAM( TZNMLFILE, 'NAM_PGDFILE', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
-CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND,ILUOUT0)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
CALL IO_Config_set()
!
@@ -199,7 +199,6 @@ IF ( (LEN_TRIM(YZOOMFILE) == 0) .OR. (ADJUSTL(YZOOMFILE) == ADJUSTL(CPGDFILE)) )
END IF
!
CALL IO_File_add2list(TZZOOMFILE,TRIM(YZOOMFILE),'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
-!PW: TODO: points to dad file (if existing) ! TZZOOMFILE%TDADFILE =>
!
CALL IO_File_open(TZZOOMFILE)
CALL WRITE_HGRID(1,TZZOOMFILE)