SUBROUTINE SUALFOUTC

!**** *SUALFOUTC - Allocations of arrays used for transmission coefficients.

!     Purpose.
!     --------

!**   Interface.
!     ----------
!        *CALL* *SUALFOUTC(...)

!        Explicit arguments : none
!        --------------------

!        Implicit arguments : none.
!        --------------------

!     Method.
!     -------
!        See documentation about spectral transforms.

!     Externals.
!     ----------
!        none 

!     Reference.
!     ----------

!     Author.
!     -------
!        K. YESSAD (CNRM/GMAP).

!     Modifications.
!     --------------
!        Original : FEB 1999
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCT0   , ONLY : NPRINTLEV,LALLOPR
USE YOMLUN   , ONLY : NULOUT
USE YOMDIM   , ONLY : NTCMAX   ,NFLEVG
USE YOMFOUTC , ONLY : RFORAB3C ,RFORAB4C ,RFORAB6C ,RFORAB3N &
 & ,RFORAB4N ,RFORAB6N ,RFORAT1C ,RFORAT2C ,RFORAT3C &
 & ,RFORAT4C ,RFORAT5C ,RFORAT1N ,RFORAT2N ,RFORAT3N &
 & ,RFORAT4N ,RFORAT5N ,RFOCOR   ,RFOAC  
USE YOMMP    , ONLY : MY_REGION_NS ,NFRSTLAT ,NLSTLAT

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IFLEVG
INTEGER(KIND=JPIM) :: INDGLL
INTEGER(KIND=JPIM) :: IU

LOGICAL :: LLP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

! ------------------------------------------------------------------

!*  1. ALLOCATIONS.
!   ---------------

IF (LHOOK) CALL DR_HOOK('SUALFOUTC',0,ZHOOK_HANDLE)
LLP = NPRINTLEV >= 1 .OR. LALLOPR
IU = NULOUT
INDGLL=NLSTLAT(MY_REGION_NS)+1-NFRSTLAT(MY_REGION_NS)

! ** Fourier representation of transmission coefficients.

! * clear-sky parallel/diffuse reflectivity.
IF (ALLOCATED(RFORAB3C)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAB3C  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAB3C(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAB3C  ',SIZE(RFORAB3C ),SHAPE(RFORAB3C )
ENDIF

! * clear-sky diffuse transmissivity.
IF (ALLOCATED(RFORAB4C)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAB4C  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAB4C(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAB4C  ',SIZE(RFORAB4C ),SHAPE(RFORAB4C )
ENDIF

! * clear-sky diffuse reflectivity.
IF (ALLOCATED(RFORAB6C)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAB6C  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAB6C(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAB6C  ',SIZE(RFORAB6C ),SHAPE(RFORAB6C )
ENDIF

! * cloudy parallel/diffuse reflectivity.
IF (ALLOCATED(RFORAB3N)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAB3N  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAB3N(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAB3N  ',SIZE(RFORAB3N ),SHAPE(RFORAB3N )
ENDIF

! * cloudy diffuse transmissivity.
IF (ALLOCATED(RFORAB4N)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAB4N  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAB4N(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAB4N  ',SIZE(RFORAB4N ),SHAPE(RFORAB4N )
ENDIF

! * cloudy diffuse reflectivity.
IF (ALLOCATED(RFORAB6N)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAB6N  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAB6N(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAB6N  ',SIZE(RFORAB6N ),SHAPE(RFORAB6N )
ENDIF

! * clear-sky parallel transmissivity.
IF (ALLOCATED(RFORAT1C)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT1C  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT1C(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT1C  ',SIZE(RFORAT1C ),SHAPE(RFORAT1C )
ENDIF

! * clear-sky parallel/diffuse transmissivity.
IF (ALLOCATED(RFORAT2C)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT2C  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT2C(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT2C  ',SIZE(RFORAT2C ),SHAPE(RFORAT2C )
ENDIF

! * clear-sky parallel/diffuse reflectivity.
IF (ALLOCATED(RFORAT3C)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT3C  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT3C(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT3C  ',SIZE(RFORAT3C ),SHAPE(RFORAT3C )
ENDIF

! * clear-sky diffuse transmissivity.
IF (ALLOCATED(RFORAT4C)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT4C  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT4C(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT4C  ',SIZE(RFORAT4C ),SHAPE(RFORAT4C )
ENDIF

! * clear-sky diffuse reflectivity.
IF (ALLOCATED(RFORAT5C)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT5C  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT5C(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT5C  ',SIZE(RFORAT5C ),SHAPE(RFORAT5C )
ENDIF

! * cloudy parallel transmissivity.
IF (ALLOCATED(RFORAT1N)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT1N  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT1N(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT1N  ',SIZE(RFORAT1N ),SHAPE(RFORAT1N )
ENDIF

! * cloudy parallel/diffuse transmissivity.
IF (ALLOCATED(RFORAT2N)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT2N  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT2N(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT2N  ',SIZE(RFORAT2N ),SHAPE(RFORAT2N )
ENDIF

! * cloudy parallel/diffuse reflectivity.
IF (ALLOCATED(RFORAT3N)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT3N  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT3N(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT3N  ',SIZE(RFORAT3N ),SHAPE(RFORAT3N )
ENDIF

! * cloudy diffuse transmissivity.
IF (ALLOCATED(RFORAT4N)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT4N  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT4N(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT4N  ',SIZE(RFORAT4N ),SHAPE(RFORAT4N )
ENDIF

! * cloudy diffuse reflectivity.
IF (ALLOCATED(RFORAT5N)) THEN
  IF(LLP)WRITE(IU,8) 'RFORAT5N  '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFORAT5N(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFORAT5N  ',SIZE(RFORAT5N ),SHAPE(RFORAT5N )
ENDIF

! * correction for cloudiness for thermal radiation.
IF (ALLOCATED(RFOCOR)) THEN
  IF(LLP)WRITE(IU,8) 'RFOCOR    '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  ALLOCATE(RFOCOR(NFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFOCOR    ',SIZE(RFOCOR   ),SHAPE(RFOCOR   )
ENDIF

! * Curtis matrix for thermal radiation for clear sky.
IF (ALLOCATED(RFOAC)) THEN
  IF(LLP)WRITE(IU,8) 'RFOAC     '
  CALL ABOR1(' SUALFOUTC: ABOR1 CALLED.')
ELSE
  IFLEVG=(NFLEVG+1)*(NFLEVG+1)
  ALLOCATE(RFOAC(IFLEVG,0:2*NTCMAX,INDGLL))
  IF(LLP)WRITE(IU,9) 'RFOAC     ',SIZE(RFOAC    ),SHAPE(RFOAC    )
ENDIF

! ------------------------------------------------------------------

8 FORMAT(1X,'ARRAY ',A10,' IS ALREADY ALLOCATED ')
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

! ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUALFOUTC',1,ZHOOK_HANDLE)
END SUBROUTINE SUALFOUTC
