From 5f72fdf253e4c4a8ac82e794de39ee032ccbf996 Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Mon, 1 Oct 2018 17:33:13 +0200
Subject: [PATCH] Quentin 01/10/2018 : set_forcing.f90 , bug for NKWH>2 => move
allocate(ZWHITE) before do loop on vertical levels
---
src/MNH/set_perturb.f90 | 46 +++++++++++++++++++++--------------------
1 file changed, 24 insertions(+), 22 deletions(-)
diff --git a/src/MNH/set_perturb.f90 b/src/MNH/set_perturb.f90
index 6c7a67203..8bc9b5cd6 100644
--- a/src/MNH/set_perturb.f90
+++ b/src/MNH/set_perturb.f90
@@ -96,6 +96,7 @@ END MODULE MODI_SET_PERTURB
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! C.Lac, V.Masson 1/2018 : White noise in the LBC
+!! Q.Rodier 10/2018 : move allocate(ZWHITE) for NKWH>2
!!
!-------------------------------------------------------------------------------
!
@@ -371,6 +372,8 @@ SELECT CASE(CPERT_KIND)
!
CASE('WH','WW') ! white noise is computed on global domain
! J.Escobar optim => need only identical random on all domain
+!
+ ALLOCATE(ZWHITE(IIU,IJU))
!
DO JK = IKB, NKWH
IKX = (NIMAX_ll+1)/2
@@ -397,7 +400,6 @@ SELECT CASE(CPERT_KIND)
END DO
END DO
!
- ALLOCATE(ZWHITE(IIU,IJU))
ZWHITE(:,:) = 0.0
!
DO JY = 1, IKY
@@ -452,31 +454,31 @@ SELECT CASE(CPERT_KIND)
!
! white noise for inflow/outflow U field in X direction
!
-IF (LWH_LBXU) THEN
- ALLOCATE(ZWHITE_ll(IIU_ll,IJU_ll))
- CALL GATHERALL_FIELD_ll('XY',ZWHITE,ZWHITE_ll,IRESP)
- DO JK=1,MIN(IKU,IIU_ll)
- DO JI=1,SIZE(XLBXUM,1)
- XLBXUM(JI,:,JK) = XLBXUM(JI,:,JK) + XAMPLIWH * ZWHITE_ll(JK,:)
- END DO
- END DO
- DEALLOCATE(ZWHITE_ll)
-END IF
+ IF (LWH_LBXU) THEN
+ ALLOCATE(ZWHITE_ll(IIU_ll,IJU_ll))
+ CALL GATHERALL_FIELD_ll('XY',ZWHITE,ZWHITE_ll,IRESP)
+ DO JK=1,MIN(IKU,IIU_ll)
+ DO JI=1,SIZE(XLBXUM,1)
+ XLBXUM(JI,:,JK) = XLBXUM(JI,:,JK) + XAMPLIWH * ZWHITE_ll(JK,:)
+ END DO
+ END DO
+ DEALLOCATE(ZWHITE_ll)
+ END IF
!
! white noise for inflow/outflow V field in Y direction
!
-IF (LWH_LBYV) THEN
- ALLOCATE(ZWHITE_ll(IIU_ll,IJU_ll))
- CALL GATHERALL_FIELD_ll('XY',ZWHITE,ZWHITE_ll,IRESP)
- DO JK=1,MIN(IKU,IJU_ll)
- DO JJ=1,SIZE(XLBXVM,2)
- XLBXVM(:,JJ,JK) = XLBXVM(:,JJ,JK) + XAMPLIWH * ZWHITE_ll(JK,:)
- END DO
- END DO
- DEALLOCATE(ZWHITE_ll)
-END IF
+ IF (LWH_LBYV) THEN
+ ALLOCATE(ZWHITE_ll(IIU_ll,IJU_ll))
+ CALL GATHERALL_FIELD_ll('XY',ZWHITE,ZWHITE_ll,IRESP)
+ DO JK=1,MIN(IKU,IJU_ll)
+ DO JJ=1,SIZE(XLBXVM,2)
+ XLBXVM(:,JJ,JK) = XLBXVM(:,JJ,JK) + XAMPLIWH * ZWHITE_ll(JK,:)
+ END DO
+ END DO
+ DEALLOCATE(ZWHITE_ll)
+ END IF
- DEALLOCATE(ZWHITE)
+ DEALLOCATE(ZWHITE)
CALL GET_HALO(XTHT)
CALL GET_HALO(XUT)
--
GitLab