Skip to content
Snippets Groups Projects
spawn_surf2_rain.f90 16.5 KiB
Newer Older
  • Learn to ignore specific revisions
  • !-----------------------------------------------------------------
    !--------------- special set of characters for RCS information
    !-----------------------------------------------------------------
    ! $Source$ $Revision$
    ! MASDEV4_7 spawn 2007/03/22 18:43:45
    !-----------------------------------------------------------------
    !###########################
    MODULE MODI_SPAWN_SURF2_RAIN
    !###########################
    !
    INTERFACE
    !
          SUBROUTINE SPAWN_SURF2_RAIN (KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,    &
                                  PINPRC,PACPRC,PINPRR,PINPRR3D,PEVAP3D,           &
                                  PACPRR,PINPRS,PACPRS,                            &
                                  PINPRG,PACPRG,PINPRH,PACPRH,                     &
                                  HSONFILE,KIUSON,KJUSON,                          &
                                  KIB2,KJB2,KIE2,KJE2,                             &
                                  KIB1,KJB1,KIE1,KJE1                              )
    !
    !
    IMPLICIT NONE
    !
    INTEGER,   INTENT(IN)  :: KXOR,KXEND !  horizontal position (i,j) of the ORigin and END  
    INTEGER,   INTENT(IN)  :: KYOR,KYEND ! of the model 2 domain, relative to model 1
    INTEGER,   INTENT(IN)  :: KDXRATIO   !  x and y-direction Resolution ratio
    INTEGER,   INTENT(IN)  :: KDYRATIO   ! between model 2 and model 1
    !
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRC,PACPRC   ! Precipitations
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRR,PACPRR   ! Precipitations
    REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D,PEVAP3D  ! Rain precipitation
                                                           ! and evaporation fluxes
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRS,PACPRS   ! Precipitations
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRG,PACPRG   ! Precipitations
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRH,PACPRH   ! Precipitations
    !
               ! Arguments for spawning with 2 input files (father+son1)
    CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: HSONFILE  ! name of the input FM-file SON
    INTEGER,           OPTIONAL, INTENT(IN) :: KIUSON    ! upper dimensions of the
    INTEGER,           OPTIONAL, INTENT(IN) :: KJUSON    !input FM-file SON
    INTEGER,           OPTIONAL, INTENT(IN) :: KIB2,KJB2 ! indexes for common
    INTEGER,           OPTIONAL, INTENT(IN) :: KIE2,KJE2 !domain in model2
    INTEGER,           OPTIONAL, INTENT(IN) :: KIB1,KJB1 !and in
    INTEGER,           OPTIONAL, INTENT(IN) :: KIE1,KJE1 !SON
    END SUBROUTINE SPAWN_SURF2_RAIN
    !
    END INTERFACE
    !
    END MODULE MODI_SPAWN_SURF2_RAIN
    !
    !
    !     #########################################################################
          SUBROUTINE SPAWN_SURF2_RAIN (KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,    &
                                  PINPRC,PACPRC,PINPRR,PINPRR3D,PEVAP3D,           &
                                  PACPRR,PINPRS,PACPRS,                            &
                                  PINPRG,PACPRG,PINPRH,PACPRH,                     &
                                  HSONFILE,KIUSON,KJUSON,                          &
                                  KIB2,KJB2,KIE2,KJE2,                             &
                                  KIB1,KJB1,KIE1,KJE1                              )
    !     #########################################################################
    !
    !!****  *SPAWN_SURF2_RAIN * - subroutine to interpolate surface precipitations
    !
    !!    PURPOSE
    !!    -------
    !!
    !!      The surface precipitations are interpolated from the model 1, to 
    !!    initialize the model 2.
    !!
    !!**  METHOD
    !!    ------
    !!
    !!      The model 2 variables are transmitted by argument (P or K prefixes),
    !!    while the ones of model 1 are declared through calls to MODD_... 
    !!    (X or N prefixes)
    !!
    !!
    !!    EXTERNAL
    !!    --------
    !!
    !!      Routine BIKHARDT2     : to perform horizontal interpolations
    !!
    !! 
    !!    IMPLICIT ARGUMENTS
    !!    ------------------ 
    !!
    !!
    !!    REFERENCE
    !!    ---------
    !!
    !!       Book1 of the documentation
    !!      
    !!
    !!    AUTHOR
    !!    ------
    !!
    !!       P. Jabouille     * METEO-FRANCE *
    !!
    !!    MODIFICATIONS
    !!    -------------
    !!
    !!      Original     19/07/04 after surface externalisation
    !!      Modification 07/07/05 (D.Barbary) spawn with 2 input files (father+son1)
    !!      Modification    20/05/06 Remove Clark and Farley interpolation
    !!-------------------------------------------------------------------------------
    !
    !*       0.     DECLARATIONS
    !               ------------
    USE MODD_LBC_n,   ONLY : LBC_MODEL
    USE MODD_PRECIP_n,ONLY : PRECIP_MODEL
    USE MODD_BIKHARDT_n
    
    USE MODD_LUNIT_n, ONLY : CLUOUT
    
    USE MODD_FIELD_n, ONLY : XTHT
    
    USE MODD_CONF,    ONLY : CCONF,CPROGRAM
    
    !
    USE MODI_BIKHARDT         ! Interface modules
    !
    USE MODE_MODELN_HANDLER
    !
    USE MODI_READ_PRECIP_FIELD
    !
    !
    IMPLICIT NONE
    !
    !
    !*       0.1   Declarations of dummy arguments :
    !
    
    INTEGER,   INTENT(IN)  :: KXOR,KXEND !  horizontal position (i,j) of the ORigin and END  
    INTEGER,   INTENT(IN)  :: KYOR,KYEND ! of the model 2 domain, relative to model 1
    INTEGER,   INTENT(IN)  :: KDXRATIO   !  x and y-direction Resolution ratio
    INTEGER,   INTENT(IN)  :: KDYRATIO   ! between model 2 and model 1
    !
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRC,PACPRC   ! Precipitations
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRR,PACPRR   ! Precipitations
    REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D,PEVAP3D  ! Rain precipitation
                                                           ! and evaporation fluxes
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRS,PACPRS   ! Precipitations
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRG,PACPRG   ! Precipitations
    REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRH,PACPRH   ! Precipitation!
    ! Arguments for spawning with 2 input files (father+son1)
    CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: HSONFILE  ! name of the input FM-file SON
    INTEGER,           OPTIONAL, INTENT(IN) :: KIUSON    ! upper dimensions of the
    INTEGER,           OPTIONAL, INTENT(IN) :: KJUSON    !input FM-file SON
    INTEGER,           OPTIONAL, INTENT(IN) :: KIB2,KJB2 ! indexes for common
    INTEGER,           OPTIONAL, INTENT(IN) :: KIE2,KJE2 !domain in model2
    INTEGER,           OPTIONAL, INTENT(IN) :: KIB1,KJB1 !and in
    INTEGER,           OPTIONAL, INTENT(IN) :: KIE1,KJE1 !SON
    !
    !*       0.2    Declarations of local variables for print on FM file
    !
    CHARACTER (LEN=2)   :: YMETHOD   ! Interpolation method ('BI', 'CF')
    INTEGER             :: IMI
    ! Variables for spawning with 2 input files (father+son1)
    REAL, DIMENSION(:,:), ALLOCATABLE :: ZINPRC1, ZACPRC1,    &
                                         ZINPRR1, ZACPRR1,    &
                                         ZINPRS1, ZACPRS1,    &
                                         ZINPRG1, ZACPRG1,    &
                                         ZINPRH1, ZACPRH1
                                             ! Instant and cumul of ground
                                             ! precipitation fields of Rain,
                                             !    Snow, Graupel and Hail
                                             ! For SON1
    REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINPRR3D1, ZEVAP3D1
    CHARACTER (LEN=4):: YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT ! READ,INIT or SKIP variable
    INTEGER             :: ILU                        ! vertical size of arrays
    !-------------------------------------------------------------------------------
    !
    !*       1.    PROLOGUE:
    !              ---------
    ! 
    IMI = GET_CURRENT_MODEL_INDEX()
    ILU=SIZE(XTHT,3)
    IF (IMI /= 2) CALL GOTO_MODEL(2)
    !*       1.1   computes dimensions of arrays and other indices
    !
    !
    !*       1.2   Interpolation method
    !
    YMETHOD='BI'
    !
    !-------------------------------------------------------------------------------
    !
    !*       3.    INITIALIZATION OF THE SURFACE VARIABLES OF MODEL 2:
    !              --------------------------------------------------
    !
    IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
    !
    !*       3.1   special case of spawning - no change of resolution :
    !
      IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
        PINPRC(:,:) = PRECIP_MODEL(1)%XINPRC(KXOR:KXEND,KYOR:KYEND)
        PACPRC(:,:) = PRECIP_MODEL(1)%XACPRC(KXOR:KXEND,KYOR:KYEND)
      END IF
    !
      IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
        PINPRR(:,:) = PRECIP_MODEL(1)%XINPRR(KXOR:KXEND,KYOR:KYEND)
        PINPRR3D(:,:,:) = PRECIP_MODEL(1)%XINPRR3D(KXOR:KXEND,KYOR:KYEND,:)
        PEVAP3D(:,:,:) = PRECIP_MODEL(1)%XEVAP3D(KXOR:KXEND,KYOR:KYEND,:)
        PACPRR(:,:) = PRECIP_MODEL(1)%XACPRR(KXOR:KXEND,KYOR:KYEND)
      END IF
    !
      IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
        PINPRS(:,:) = PRECIP_MODEL(1)%XINPRS(KXOR:KXEND,KYOR:KYEND)
        PACPRS(:,:) = PRECIP_MODEL(1)%XACPRS(KXOR:KXEND,KYOR:KYEND)
      END IF
    !
      IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
        PINPRG(:,:) = PRECIP_MODEL(1)%XINPRG(KXOR:KXEND,KYOR:KYEND)
        PACPRG(:,:) = PRECIP_MODEL(1)%XACPRG(KXOR:KXEND,KYOR:KYEND)
      END IF
    !
      IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
        PINPRH(:,:) = PRECIP_MODEL(1)%XINPRH(KXOR:KXEND,KYOR:KYEND)
        PACPRH(:,:) = PRECIP_MODEL(1)%XACPRH(KXOR:KXEND,KYOR:KYEND)
      END IF
    !
    !
    !-------------------------------------------------------------------------------
    !
    ELSE
    !
    !*       3.2  general case - change of resolution :
    !             -----------------------------------
    !
    !*       3.2.1   Bikhardt interpolation
    !
    !
      IF ( YMETHOD == 'BI' ) THEN
    !
        IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRC,PINPRC)
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRC,PACPRC)
         PINPRC(:,:)=MAX(0.,PINPRC(:,:))
         PACPRC(:,:)=MAX(0.,PACPRC(:,:))
        END IF
    !
        IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRR,PINPRR)
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRR3D,PINPRR3D)
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XEVAP3D,PEVAP3D)
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRR,PACPRR)
         PINPRR(:,:)=MAX(0.,PINPRR(:,:))
         PINPRR3D(:,:,:)=MAX(0.,PINPRR3D(:,:,:))
         PEVAP3D(:,:,:)=MAX(0.,PEVAP3D(:,:,:))
         PACPRR(:,:)=MAX(0.,PACPRR(:,:))
        END IF
    !
        IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRS,PINPRS)
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRS,PACPRS)
         PINPRS(:,:)=MAX(0.,PINPRS(:,:))
         PACPRS(:,:)=MAX(0.,PACPRS(:,:))
        END IF
    !
        IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRG,PINPRG)
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRG,PACPRG)
         PINPRG(:,:)=MAX(0.,PINPRG(:,:))
         PACPRG(:,:)=MAX(0.,PACPRG(:,:))
        END IF
    !
        IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRH,PINPRH)
          CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
                        XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
                        KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1,       &
                        LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRH,PACPRH)
         PINPRH(:,:)=MAX(0.,PINPRH(:,:))
         PACPRR(:,:)=MAX(0.,PACPRH(:,:))
        END IF
    !
      END IF
    !
    !-------------------------------------------------------------------------------
    !
    END IF
    !
    !*       3.3  Informations from model SON1
    !             ----------------------------
    !
    IF (PRESENT(HSONFILE)) THEN
      IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
        ALLOCATE(ZINPRC1(KIUSON,KJUSON))
        ALLOCATE(ZACPRC1(KIUSON,KJUSON))
        YGETRRT='READ'
      ELSE
        ALLOCATE(ZINPRC1(0,0))
        ALLOCATE(ZACPRC1(0,0))
        YGETRRT='SKIP'
      END IF
      IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
        ALLOCATE(ZINPRR1(KIUSON,KJUSON))
        ALLOCATE(ZINPRR3D1(KIUSON,KJUSON,ILU))
        ALLOCATE(ZEVAP3D1(KIUSON,KJUSON,ILU))
        ALLOCATE(ZACPRR1(KIUSON,KJUSON))
        YGETRRT='READ'
      ELSE
        ALLOCATE(ZINPRR1(0,0))
        ALLOCATE(ZINPRR3D1(0,0,0))
        ALLOCATE(ZEVAP3D1(0,0,0))
        ALLOCATE(ZACPRR1(0,0))
        YGETRRT='SKIP'
      END IF
      IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
        ALLOCATE(ZINPRS1(KIUSON,KJUSON))
        ALLOCATE(ZACPRS1(KIUSON,KJUSON))
        YGETRST='READ'
      ELSE
        ALLOCATE(ZINPRS1(0,0))
        ALLOCATE(ZACPRS1(0,0))
        YGETRST='SKIP'
      END IF
      IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
        ALLOCATE(ZINPRG1(KIUSON,KJUSON))
        ALLOCATE(ZACPRG1(KIUSON,KJUSON))
        YGETRGT='READ'
      ELSE
        ALLOCATE(ZINPRG1(0,0))
        ALLOCATE(ZACPRG1(0,0))
        YGETRGT='SKIP'
      END IF
      IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
        ALLOCATE(ZINPRH1(KIUSON,KJUSON))
        ALLOCATE(ZACPRH1(KIUSON,KJUSON))
        YGETRHT='READ'
      ELSE
        ALLOCATE(ZINPRH1(0,0))
        ALLOCATE(ZACPRH1(0,0))
        YGETRHT='SKIP'
      END IF
    
      CALL READ_PRECIP_FIELD(HSONFILE,CLUOUT,CPROGRAM,CCONF,                          &
                             YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT,                 &
    
                             ZINPRC1,ZACPRC1,ZINPRR1,ZINPRR3D1,ZEVAP3D1,              &
    
                             ZACPRR1,ZINPRS1,ZACPRS1,                                 &
    
                             ZINPRG1,ZACPRG1,ZINPRH1,ZACPRH1                          )
      IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
        PINPRC(KIB2:KIE2,KJB2:KJE2) = ZINPRC1(KIB1:KIE1,KJB1:KJE1)
        PACPRC(KIB2:KIE2,KJB2:KJE2) = ZACPRC1(KIB1:KIE1,KJB1:KJE1)
      END IF
      DEALLOCATE(ZINPRC1)
      DEALLOCATE(ZACPRC1)
      IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
        PINPRR(KIB2:KIE2,KJB2:KJE2) = ZINPRR1(KIB1:KIE1,KJB1:KJE1)
        PINPRR3D(KIB2:KIE2,KJB2:KJE2,:) = ZINPRR3D1(KIB1:KIE1,KJB1:KJE1,:)
        PEVAP3D(KIB2:KIE2,KJB2:KJE2,:) = ZEVAP3D1(KIB1:KIE1,KJB1:KJE1,:)
        PACPRR(KIB2:KIE2,KJB2:KJE2) = ZACPRR1(KIB1:KIE1,KJB1:KJE1)
      END IF
      DEALLOCATE(ZINPRR1)
      DEALLOCATE(ZINPRR3D1)
      DEALLOCATE(ZEVAP3D1)
      DEALLOCATE(ZACPRR1)
      IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
        PINPRS(KIB2:KIE2,KJB2:KJE2) = ZINPRS1(KIB1:KIE1,KJB1:KJE1)
        PACPRS(KIB2:KIE2,KJB2:KJE2) = ZACPRS1(KIB1:KIE1,KJB1:KJE1)
      END IF
      DEALLOCATE(ZINPRS1)
      DEALLOCATE(ZACPRS1)
      IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
        PINPRG(KIB2:KIE2,KJB2:KJE2) = ZINPRG1(KIB1:KIE1,KJB1:KJE1)
        PACPRG(KIB2:KIE2,KJB2:KJE2) = ZACPRG1(KIB1:KIE1,KJB1:KJE1)
      END IF
      DEALLOCATE(ZINPRG1)
      DEALLOCATE(ZACPRG1)
      IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
        PINPRH(KIB2:KIE2,KJB2:KJE2) = ZINPRH1(KIB1:KIE1,KJB1:KJE1)
        PACPRH(KIB2:KIE2,KJB2:KJE2) = ZACPRH1(KIB1:KIE1,KJB1:KJE1)
      END IF
      DEALLOCATE(ZINPRH1)
      DEALLOCATE(ZACPRH1)
    END IF
    !
    !
    !-------------------------------------------------------------------------------
    !
    END SUBROUTINE SPAWN_SURF2_RAIN