Skip to content
Snippets Groups Projects
Commit ae40fe67 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 09/05/2023: FFT/ZSOLVER: allocate solver arrays only when needed

parent 08f52578
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/ini_modeln.f90
+ 53
− 24
View file @ ae40fe67
......@@ -1077,14 +1077,22 @@ END IF
!* 3.5 Module MODD_DYN_n
!
CALL GET_DIM_EXT_ll('Y',IIY,IJY)
IF (L2D) THEN
ALLOCATE(XBFY(IIY,IJY,IKU))
IF ( CPRESOPT /= 'ZSOLV' ) THEN
IF (L2D) THEN
ALLOCATE(XBFY(IIY,IJY,IKU))
ELSE
ALLOCATE(XBFY(IJY,IIY,IKU)) ! transposition needed by the optimisation of the
! FFT solver
END IF
ELSE
ALLOCATE(XBFY(IJY,IIY,IKU)) ! transposition needed by the optimisation of the
! FFT solver
ALLOCATE(XBFY(0,0,0))
END IF
CALL GET_DIM_EXT_ll('B',IIU_B,IJU_B)
ALLOCATE(XBFB(IIU_B,IJU_B,IKU))
IF ( CPRESOPT == 'ZRESI' .OR. CPRESOPT == 'ZSOLV' ) THEN
ALLOCATE(XBFB(IIU_B,IJU_B,IKU))
END IF
#ifdef MNH_MGSOLVER
IF ( CPRESOPT == 'ZSOLV' ) THEN
ALLOCATE(XAF_ZS(IIU_B,IJU_B,IKU))
......@@ -1097,13 +1105,34 @@ IF ( CPRESOPT == 'ZSOLV' ) THEN
ALLOCATE(XB_K(IKU))
ALLOCATE(XC_K(IKU))
ALLOCATE(XD_K(IKU))
ELSE
ALLOCATE(XAF_ZS(0,0,0))
ALLOCATE(XBF_ZS(0,0,0))
ALLOCATE(XCF_ZS(0,0,0))
ALLOCATE(XDXATH_ZS(0,0))
ALLOCATE(XDYATH_ZS(0,0))
ALLOCATE(XRHO_ZS(0,0,0))
ALLOCATE(XA_K(0))
ALLOCATE(XB_K(0))
ALLOCATE(XC_K(0))
ALLOCATE(XD_K(0))
END IF
#endif
CALL GET_DIM_EXTZ_ll('SXP2_YP1_Z',IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll)
ALLOCATE(XBF_SXP2_YP1_Z(IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll))
ALLOCATE(XAF(IKU),XCF(IKU))
ALLOCATE(XTRIGSX(3*IIU_ll))
ALLOCATE(XTRIGSY(3*IJU_ll))
IF ( CPRESOPT == 'ZRESI' ) THEN
CALL GET_DIM_EXTZ_ll('SXP2_YP1_Z',IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll)
ALLOCATE(XBF_SXP2_YP1_Z(IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll))
ELSE
ALLOCATE(XBF_SXP2_YP1_Z(0,0,0))
END IF
IF ( CPRESOPT /= 'ZSOLV' ) THEN
ALLOCATE(XAF(IKU),XCF(IKU))
ALLOCATE(XTRIGSX(3*IIU_ll))
ALLOCATE(XTRIGSY(3*IJU_ll))
ELSE
ALLOCATE(XAF(0),XCF(0))
ALLOCATE(XTRIGSX(0))
ALLOCATE(XTRIGSY(0))
END IF
ALLOCATE(XRHOM(IKU))
!$acc enter data create( XRHOM, XAF, XBFY, XCF, XTRIGSX, XTRIGSY, NIFAXX, NIFAXY, XBFB, XBF_SXP2_YP1_Z )
ALLOCATE(XALK(IKU))
......@@ -2193,20 +2222,20 @@ IF ( KMI > 1) THEN
DPTR_XLBXSVM=>XLBXSVM
DPTR_XLBYSVM=>XLBYSVM
IF (CCONF=='START') THEN
CALL INI_ONE_WAY_n(NDAD(KMI),KMI, &
DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), &
DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, &
DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, &
CCLOUD, LUSECHAQ, LUSECHIC, &
DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, &
DPTR_XLBXTHM,DPTR_XLBYTHM, &
DPTR_XLBXTKEM,DPTR_XLBYTKEM, &
DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM )
CALL INI_ONE_WAY_n(NDAD(KMI),KMI, &
DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), &
DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, &
DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, &
CCLOUD, LUSECHAQ, LUSECHIC, &
DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, &
DPTR_XLBXTHM,DPTR_XLBYTHM, &
DPTR_XLBXTKEM,DPTR_XLBYTKEM, &
DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM )
ENDIF
END IF
!
......
src/MNH/tridz.f90
+ 36
− 15
View file @ ae40fe67
......@@ -552,10 +552,12 @@ IF ( HPRESOPT == 'ZSOLV' ) THEN
C_K = 0.0
END IF
#endif
DO JK = IKB,IKE
PAF(JK) = 0.5 * ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2
PCF(JK) = 0.5 * ( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1) **2
END DO
IF ( HPRESOPT /= 'ZSOLV' ) THEN
DO JK = IKB,IKE
PAF(JK) = 0.5 * ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2
PCF(JK) = 0.5 * ( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1) **2
END DO
END IF
#ifdef MNH_MGSOLVER
IF ( HPRESOPT == 'ZSOLV' ) THEN
......@@ -566,8 +568,8 @@ IF ( HPRESOPT == 'ZSOLV' ) THEN
/ ZDZM_ZS(IIB:IIE,IJB:IJE,JK+1) **2
D_K(JK) = PRHOM(JK) ! / ZDZM(JK)
B_K(JK) = PCF(JK) / D_K(JK)
C_K(JK) = PAF(JK) / D_K(JK)
B_K(JK) = ( 0.5 * ( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1) **2 ) / D_K(JK)
C_K(JK) = ( 0.5 * ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 ) / D_K(JK)
END DO
END IF
#endif
......@@ -575,28 +577,32 @@ END IF
! at the upper and lower levels PAF and PCF are computed using the Neumann
! conditions applying on the vertical component of the gradient
!
PAF(IKE+1) = -0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2
IF ( HPRESOPT /= 'ZSOLV' ) THEN
PAF(IKE+1) = -0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1)**2
END IF
#ifdef MNH_MGSOLVER
IF ( HPRESOPT == 'ZSOLV' ) THEN
D_K(IKE+1) = PRHOM(IKE+1) ! / ZDZM(IKE+1)
C_K(IKE+1) = PAF(IKE+1) / D_K(IKE+1)
C_K(IKE+1) = ( -0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2 ) / D_K(IKE+1)
END IF
#endif
PCF(IKB-1) = 0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / ZDZM(IKB) **2
IF ( HPRESOPT /= 'ZSOLV' ) THEN
PCF(IKB-1) = 0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / ZDZM(IKB)**2
END IF
#ifdef MNH_MGSOLVER
IF ( HPRESOPT == 'ZSOLV' ) THEN
D_K(IKB-1) = PRHOM(IKB-1) ! / ZDZM(IKB-1)
B_K(IKB-1) = PCF(IKB-1) / D_K(IKB-1)
B_K(IKB-1) = ( 0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / ZDZM(IKB)**2 ) / D_K(IKB-1)
END IF
#endif
!
PAF(IKB-1) = 0.0 ! 0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / ZDZM(IKB) **2
IF ( HPRESOPT /= 'ZSOLV' ) PAF(IKB-1) = 0.0 ! 0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / ZDZM(IKB) **2
#ifdef MNH_MGSOLVER
IF ( HPRESOPT == 'ZSOLV' ) C_K(IKB-1) = 0.0
#endif
PCF(IKE+1) = 0.0 ! 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2
IF ( HPRESOPT /= 'ZSOLV' ) PCF(IKE+1) = 0.0 ! 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2
#ifdef MNH_MGSOLVER
IF ( HPRESOPT == 'ZSOLV' ) THEN
B_K(IKE+1) = 0.0
......@@ -715,11 +721,12 @@ DEALLOCATE(ZEIGENX_ll)
!* 7.2 compute the matrix diagonal elements
!
!
PBFY = 1.
PBFB = 1. ! JUAN Z_SLIDE
PBF_SXP2_YP1_Z = 1. ! JUAN Z_SLIDE
IF ( HPRESOPT /= 'ZSOLV' ) PBFY = 1.
IF ( HPRESOPT == 'ZRESI' .OR. HPRESOPT == 'ZSOLV' ) PBFB = 1. ! JUAN Z_SLIDE
IF ( HPRESOPT == 'ZRESI' ) PBF_SXP2_YP1_Z = 1. ! JUAN Z_SLIDE
!
IF (L2D) THEN
IF ( HPRESOPT /= 'ZSOLV' ) THEN
DO JK= IKB,IKE
DO JJ= 1, IYMODEY_ll
DO JI= 1, IXMODEY_ll
......@@ -737,8 +744,10 @@ IF (L2D) THEN
!
PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
ZDZM(IKE+1) **2
END IF
!
ELSE
IF ( HPRESOPT /= 'ZSOLV' ) THEN
IF ( CSPLIT /= 'BSPLITTING' ) THEN
!print*,"WARNING CSPLIT /= 'BSPLITTING =", CSPLIT
DO JK= IKB,IKE
......@@ -759,6 +768,7 @@ ELSE
PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
ZDZM(IKE+1) **2
END IF
END IF
!
!JUAN Z_SPLITTING
......@@ -767,6 +777,7 @@ ELSE
#ifdef MNH_MGSOLVER
IF ( HPRESOPT == 'ZSOLV' ) PBF_ZS(:,:,:) = 1.0
#endif
IF ( HPRESOPT == 'ZRESI' .OR. HPRESOPT == 'ZSOLV' ) THEN
DO JK= IKB,IKE
DO JJ= IJB,IJE
DO JI= IIB, IIE
......@@ -776,6 +787,7 @@ ELSE
END DO
END DO
END DO
END IF
#ifdef MNH_MGSOLVER
IF ( HPRESOPT == 'ZSOLV' ) THEN
DO JK= IKB,IKE
......@@ -792,9 +804,11 @@ ELSE
! at the upper and lower levels PBFB is computed using the Neumann
! condition
!
IF ( HPRESOPT == 'ZRESI' .OR. HPRESOPT == 'ZSOLV' ) THEN
PBFB(IIB:IIE,IJB:IJE,IKB-1) = - 0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / ZDZM(IKB) **2
!
PBFB(IIB:IIE,IJB:IJE,IKE+1) = + 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2
END IF
#ifdef MNH_MGSOLVER
IF ( HPRESOPT == 'ZSOLV' ) THEN
PBF_ZS(IIB:IIE,IJB:IJE,IKB-1) = - 0.5 * ( PRHO_ZS(IIB:IIE,IJB:IJE,IKB-1) + PRHO_ZS(IIB:IIE,IJB:IJE,IKB) ) &
......@@ -822,6 +836,7 @@ END IF
!JUAN Z_SPLITTING
!JUAN for Z splitting we need to do the vertical substitution
!JUAN in _SXP2_YP1_Zsplitting slides so need PBF_SXP2_YP1_Z
IF ( HPRESOPT == 'ZRESI' ) THEN
DO JK=IKB,IKE
DO JJ= 1, IJU_SXP2_YP1_Z_ll
DO JI= 1, IIU_SXP2_YP1_Z_ll
......@@ -842,12 +857,15 @@ END IF
!
!JUAN Z_SPLITTING
END IF
END IF
!
! second coefficent is meaningless in cyclic case
IF ( HPRESOPT /= 'ZSOLV' ) THEN
IF (HLBCX(1) == 'CYCL' .AND. L2D .AND. SIZE(PBFY,1) .GE. 2 ) PBFY(2,:,:)=1.
IF (HLBCX(1) == 'CYCL' .AND. .NOT.(L2D) .AND. LWEST_ll(HSPLITTING='Y') .AND. SIZE(PBFY,2) .GE.2 ) &
PBFY(:,2,:)=1.
IF (HLBCY(1) == 'CYCL' .AND. .NOT.(L2D) .AND. SIZE(PBFY,1) .GE. 2 ) PBFY(2,:,:)=1.
END IF
!JUAN Z_SPLITTING
! second coefficent is meaningless in cyclic case
!IF (HLBCX(1) == 'CYCL' .AND. L2D .AND. SIZE(PBFB,1) .GE. 2 ) PBFB(2,:,:)=1.
......@@ -862,6 +880,7 @@ DEALLOCATE(ZEIGEN_ll)
!------------------------------------------------------------------------------
!* 8. INITIALIZATION OF THE TRIGS AND IFAX ARRAYS FOR THE FFT
! -------------------------------------------------------
NOT_ZSOLV: IF ( HPRESOPT /= 'ZSOLV' ) THEN
!
! 8.1 x lateral boundary conditions
!
......@@ -936,6 +955,8 @@ IF (.NOT. L2D) THEN
ENDIF
!
ENDIF
END IF NOT_ZSOLV
!
!------------------------------------------------------------------------------
!
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme