S. Riette 12 Sept 2023: solves #26

UMR-CNRM · Sep 12, 2023 · 41c6be7 · 41c6be7
1 parent 084d58d
commit 41c6be7
Show file tree

Hide file tree

Showing 5 changed files with 39 additions and 29 deletions.
diff --git a/src/common/micro/mode_rain_ice_old_fast_rg.F90 b/src/common/micro/mode_rain_ice_old_fast_rg.F90
@@ -185,8 +185,8 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RG(D, CST, ICEP, ICED, BUCONF,                &
 !
 !*       6.2.3  select the (PLBDAG,PLBDAS) couplet
 !
-      ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) )
-      ZVEC2(:) = PACK( PLBDAS(:),MASK=GDRY(:) )
+      ZVEC1(1:IGDRY) = PACK( PLBDAG(:),MASK=GDRY(:) )
+      ZVEC2(1:IGDRY) = PACK( PLBDAS(:),MASK=GDRY(:) )
 !
 !*       6.2.4  find the next lower indice for the PLBDAG and for the PLBDAS
 !               in the geometrical set of (Lbda_g,Lbda_s) couplet use to
@@ -213,7 +213,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RG(D, CST, ICEP, ICED, BUCONF,                &
                       - ICEP%XKER_SDRYG(IVEC1(JJ)  ,IVEC2(JJ)  )*(ZVEC2(JJ) - 1.0) ) &
                                                            * (ZVEC1(JJ) - 1.0)
       END DO
-      ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+      ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGDRY),MASK=GDRY,FIELD=0.0 )
 !
       IF (OCND2) THEN
         ZZW1(:,3) = 0.
@@ -242,8 +242,8 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RG(D, CST, ICEP, ICED, BUCONF,                &
 !
 !*       6.2.8  select the (PLBDAG,PLBDAR) couplet
 !
-      ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) )
-      ZVEC2(:) = PACK( PLBDAR(:),MASK=GDRY(:) )
+      ZVEC1(1:IGDRY) = PACK( PLBDAG(:),MASK=GDRY(:) )
+      ZVEC2(1:IGDRY) = PACK( PLBDAR(:),MASK=GDRY(:) )
 !
 !*       6.2.9  find the next lower indice for the PLBDAG and for the PLBDAR
 !               in the geometrical set of (Lbda_g,Lbda_r) couplet use to
@@ -270,7 +270,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RG(D, CST, ICEP, ICED, BUCONF,                &
                       - ICEP%XKER_RDRYG(IVEC1(JJ)  ,IVEC2(JJ)  )*(ZVEC2(JJ) - 1.0)) &
                                                                 *(ZVEC1(JJ) - 1.0)
       END DO
-      ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+      ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGDRY),MASK=GDRY,FIELD=0.0 )
 
       DO JK = 1, KSIZE
         IF (GDRY(JK)) THEN

diff --git a/src/common/micro/mode_rain_ice_old_fast_rh.F90 b/src/common/micro/mode_rain_ice_old_fast_rh.F90
@@ -149,8 +149,8 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RH(D, CST, ICEP, ICED, BUCONF, &
 !
 !*       7.2.3  select the (PLBDAH,PLBDAS) couplet
 !
-        ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) )
-        ZVEC2(:) = PACK( PLBDAS(:),MASK=GWET(:) )
+        ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
+        ZVEC2(1:IGWET) = PACK( PLBDAS(:),MASK=GWET(:) )
 !
 !*       7.2.4  find the next lower indice for the PLBDAG and for the PLBDAS
 !               in the geometrical set of (Lbda_h,Lbda_s) couplet use to
@@ -177,7 +177,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RH(D, CST, ICEP, ICED, BUCONF, &
                        - ICEP%XKER_SWETH(IVEC1(JJ)  ,IVEC2(JJ)  )*(ZVEC2(JJ) - 1.0) ) &
                                                                 * (ZVEC1(JJ) - 1.0)
         END DO
-        ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+        ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
 
         DO JK = 1, KSIZE
           IF (GWET(JK)) THEN
@@ -200,8 +200,8 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RH(D, CST, ICEP, ICED, BUCONF, &
 !
 !*       7.2.8  select the (PLBDAH,PLBDAG) couplet
 !
-        ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) )
-        ZVEC2(:) = PACK( PLBDAG(:),MASK=GWET(:) )
+        ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
+        ZVEC2(1:IGWET) = PACK( PLBDAG(:),MASK=GWET(:) )
 !
 !*       7.2.9  find the next lower indice for the PLBDAH and for the PLBDAG
 !               in the geometrical set of (Lbda_h,Lbda_g) couplet use to
@@ -228,7 +228,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RH(D, CST, ICEP, ICED, BUCONF, &
                        - ICEP%XKER_GWETH(IVEC1(JJ)  ,IVEC2(JJ)  )*(ZVEC2(JJ) - 1.0) ) &
                                                                 * (ZVEC1(JJ) - 1.0)
         END DO
-        ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+        ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
 
         DO JK = 1, KSIZE
           IF (GWET(JK)) THEN

diff --git a/src/common/micro/mode_rain_ice_old_fast_rs.F90 b/src/common/micro/mode_rain_ice_old_fast_rs.F90
@@ -114,7 +114,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RS(D, CST, ICEP, ICED, BUCONF,         &
 !
 !        5.1.1  select the ZLBDAS
 !
-      ZVEC1(:) = PACK( ZLBDAS(:),MASK=GMASK(:) )
+      ZVEC1(1:IGRIM) = PACK( ZLBDAS(:),MASK=GMASK(:) )
 !
 !        5.1.2  find the next lower indice for the ZLBDAS in the geometrical
 !               set of Lbda_s used to tabulate some moments of the incomplete
@@ -130,7 +130,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RS(D, CST, ICEP, ICED, BUCONF,         &
 !
       ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM1(IVEC2(1:IGRIM)+1)* ZVEC2(1:IGRIM)      &
                    - ICEP%XGAMINC_RIM1(IVEC2(1:IGRIM)  )*(ZVEC2(1:IGRIM) - 1.0)
-      ZZW(:) = UNPACK(VECTOR=ZVEC1(:), MASK=GMASK, FIELD=0.0)
+      ZZW(:) = UNPACK(VECTOR=ZVEC1(1:IGRIM), MASK=GMASK, FIELD=0.0)
 !
 !        5.1.4  riming of the small sized aggregates
 !
@@ -151,7 +151,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RS(D, CST, ICEP, ICED, BUCONF,         &
 !
       ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM)      &
                      - ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM)   )*(ZVEC2(1:IGRIM) - 1.0)
-      ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GMASK,FIELD=0.0 )
+      ZZW(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GMASK,FIELD=0.0 )
 !
 !        5.1.6  riming-conversion of the large sized aggregates into graupeln
 !
@@ -200,8 +200,8 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RS(D, CST, ICEP, ICED, BUCONF,         &
 !
 !        5.2.1  select the (ZLBDAS,ZLBDAR) couplet
 !
-      ZVEC1(:) = PACK( ZLBDAS(:),MASK=GMASK(:) )
-      ZVEC2(:) = PACK( ZLBDAR(:),MASK=GMASK(:) )
+      ZVEC1(1:IGACC) = PACK( ZLBDAS(:),MASK=GMASK(:) )
+      ZVEC2(1:IGACC) = PACK( ZLBDAR(:),MASK=GMASK(:) )
 !
 !        5.2.2  find the next lower indice for the ZLBDAS and for the ZLBDAR
 !               in the geometrical set of (Lbda_s,Lbda_r) couplet use to
@@ -228,7 +228,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RS(D, CST, ICEP, ICED, BUCONF,         &
                     - ICEP%XKER_RACCSS(IVEC1(JJ)  ,IVEC2(JJ)  )*(ZVEC2(JJ) - 1.0)) &
                                                                *(ZVEC1(JJ) - 1.0)
       END DO
-      ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GMASK,FIELD=0.0 )
+      ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GMASK,FIELD=0.0 )
 !
 !        5.2.4  raindrop accretion on the small sized aggregates
 !
@@ -257,7 +257,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RS(D, CST, ICEP, ICED, BUCONF,         &
                    -  ICEP%XKER_RACCS(IVEC2(JJ)  ,IVEC1(JJ)  )*(ZVEC1(JJ) - 1.0) ) &
                                                               *(ZVEC2(JJ) - 1.0)
       END DO
-      ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GMASK(:),FIELD=0.0 )
+      ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GMASK(:),FIELD=0.0 )
                                                                        !! RRACCS!
 !        5.2.5  perform the bilinear interpolation of the normalized
 !               SACCRG-kernel
@@ -270,7 +270,7 @@ SUBROUTINE RAIN_ICE_OLD_FAST_RS(D, CST, ICEP, ICED, BUCONF,         &
                       - ICEP%XKER_SACCRG(IVEC2(JJ)  ,IVEC1(JJ)  )*(ZVEC1(JJ) - 1.0) ) &
                                                           * (ZVEC2(JJ) - 1.0)
       END DO
-      ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GMASK,FIELD=0.0 )
+      ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GMASK,FIELD=0.0 )
 !
 !        5.2.6  raindrop accretion-conversion of the large sized aggregates
 !               into graupeln

diff --git a/src/testprogs/rain_ice_old/getdata_rain_ice_old_mod.F90 b/src/testprogs/rain_ice_old/getdata_rain_ice_old_mod.F90
@@ -540,12 +540,17 @@ PURE SUBROUTINE NPROMIZE3(P_IN, P_OUT)
     DO K_OUT = 1, NBLOCKS
       DO J = 1, SIZE(P_OUT, 2)
 
-        ZLEV = 1.0 + REAL(J-1)*REAL(SIZE(P_IN,2))/REAL(SIZE(P_OUT,2))
-        JLEVB = MIN(CEILING(ZLEV), SIZE(P_OUT,2))
+        ZLEV = 1.0 + REAL(J-1)*REAL(SIZE(P_IN,2)-1)/REAL(SIZE(P_OUT,2)-1)
+        JLEVB = MIN(CEILING(ZLEV), SIZE(P_IN,2))
         JLEVA = MAX(FLOOR(ZLEV), 1)
 
-        ZWA = REAL(JLEVB) - ZLEV
-        ZWB = ZLEV - REAL(JLEVA)
+        IF (JLEVB == JLEVA) THEN
+          ZWA = 1.
+          ZWB = 0.
+        ELSE
+          ZWA = REAL(JLEVB) - ZLEV
+          ZWB = ZLEV - REAL(JLEVA)
+        ENDIF
 
         DO I_OUT = 1, NPROMA
 
@@ -616,12 +621,17 @@ PURE SUBROUTINE NPROMIZE4(P_IN, P_OUT)
       DO J2 = 1, SIZE(P_OUT, 3)
         DO J1 = 1, SIZE(P_OUT, 2)
 
-          ZLEV = 1.0 + REAL(J1-1)*REAL(SIZE(P_IN,2))/REAL(SIZE(P_OUT,2))
-          JLEVB = MIN(CEILING(ZLEV), SIZE(P_OUT,2))
+          ZLEV = 1.0 + REAL(J1-1)*REAL(SIZE(P_IN,2)-1)/REAL(SIZE(P_OUT,2)-1)
+          JLEVB = MIN(CEILING(ZLEV), SIZE(P_IN,2))
           JLEVA = MAX(FLOOR(ZLEV), 1)
 
-          ZWA = REAL(JLEVB) - ZLEV
-          ZWB = ZLEV - REAL(JLEVA)
+          IF (JLEVB == JLEVA) THEN
+            ZWA = 1.
+            ZWB = 0.
+          ELSE
+            ZWA = REAL(JLEVB) - ZLEV
+            ZWB = ZLEV - REAL(JLEVA)
+          ENDIF
 
           DO I_OUT = 1, NPROMA
 

diff --git a/src/testprogs/rain_ice_old/main_rain_ice_old.F90 b/src/testprogs/rain_ice_old/main_rain_ice_old.F90
@@ -389,7 +389,7 @@ subroutine init_rain_ice_old(kulout)
   call rain_ice_descr_goto_model(1, 1)
   call rain_ice_param_goto_model(1, 1)
 
-  call param_icen_init('AROME', 0, .false., kulout, &                                                                 
+  call param_icen_init('AROME ', 0, .false., kulout, &                                                                 
                       &.true., .false., .false., 0)
 
   call tbuconf_associate