SUBROUTINE RDRADCOEF (KSTA,KEND,KJUMP,&
 & KFIELDSS,&
 & PRAB3C,PRAB3N,PRAB4C,PRAB4N,PRAB6C,PRAB6N,&
 & PRAT1C,PRAT1N,PRAT2C,PRAT2N,PRAT3C,PRAT3N,&
 & PRAT4C,PRAT4N,PRAT5C,PRAT5N,PCOR,PAC)  

!**** *RDRADCOF* - Read out the constants for solar and thermal radiation

!     Purpose.  Read out the constants for solar and thermal radiation
!     --------  (grid-point transmission coefficients) from work file:
!               they are used in the simplified physics.

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

!        Explicit arguments :  KSTA     - start adress         (input)
!                              KEND     - end adress           (input)
!                              KJUMP    - offset into gp array (input)
!                              KFIELDSS - number of fields     (input)
!                              PRAB3C to PAC: transmission coefficients (output)

!        Implicit arguments :  None
!        --------------------

!     Method.
!     -------

!     Externals. EMPTB - interface to packing routines
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        M. Janiskova

!     Modifications.
!     --------------
!        Original : 99-02-09
!        Modified :
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA
USE YOMRCOEF , ONLY : LGLOBRAD &
 & , NLENGSRB ,SOLRAD &
 & ,THERRAD &
 & , NPCKFSR  ,NEXPBSR &
 & , NPCKFTHR ,NEXPBTHR &
 & , NLATWR   ,NLATRD  

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

IMPLICIT NONE

! * INPUT:
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
INTEGER(KIND=JPIM),INTENT(IN)    :: KJUMP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELDSS 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAB3C(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAB3N(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAB4C(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAB4N(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAB6C(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAB6N(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT1C(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT1N(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT2C(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT2N(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT3C(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT3N(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT4C(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT4N(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT5C(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAT5N(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOR(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAC(NFLEVG+1,NFLEVG+1) 
! * OUTPUT:
INTEGER(KIND=JPIM) :: IBLOCKSS, IJUMP, ILENBS, ILENBT, IPCKUNITS, ISTAGPSB, &
 & ISTAGPTB, IWORDS, IWORDT, JF  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "emptb.intfb.h"

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

!*       1.    READ OUT GRIDPOINT ARRAY.
!              --------------------------

IF (LHOOK) CALL DR_HOOK('RDRADCOEF',0,ZHOOK_HANDLE)
NLATRD=NLATRD+1

!*       1.1       CALCULATE LENGTHS

IWORDS = KEND-KSTA+1
IWORDT = NFLEVG+1

!*       1.2       READ OUT BUFFER

ILENBS   = NLENGSRB
ILENBT   = (NFLEVG+1)*(NFLEVG+1)

IJUMP=KJUMP-1

IF (NPCKFSR == 1) THEN
  ISTAGPSB = 1+IJUMP*KFIELDSS
ELSE
  IBLOCKSS=IJUMP/NPROMA
  IF (IBLOCKSS*NPROMA /= IJUMP)&
   & CALL ABOR1('SOLRAD: INCONSISTENT WRITING OF PACKED DATA')  
  IPCKUNITS = (NPROMA+NPCKFSR-1)/NPCKFSR
  ISTAGPSB = 1+IPCKUNITS*IBLOCKSS*KFIELDSS
ENDIF

IF (NPCKFTHR == 1) THEN
  ISTAGPTB = 1
ELSE
  CALL ABOR1('THERRAD: NPCKFTHR CANNOT BE DIFFERENT THAN 1')
ENDIF

!        1.3      SOLAR RADIATION COEFFICIENTS, CORRECTION FACTOR
!                 FOR THERMAL RADIATION AND MATRIX OF THERMAL
!                 RADIATION COEFFICIENTS

DO JF=1,NFLEVG
  CALL EMPTB(IWORDS,PRAB3C(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAB3N(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAB4C(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAB4N(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAB6C(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAB6N(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  

  CALL EMPTB(IWORDS,PRAT1C(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT1N(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT2C(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT2N(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT3C(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT3N(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT4C(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT4N(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT5C(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
  CALL EMPTB(IWORDS,PRAT5N(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  

  CALL EMPTB(IWORDS,PCOR(KSTA,JF),SOLRAD(:),&
   & ILENBS,ISTAGPSB,NPCKFSR,NEXPBSR)  
ENDDO

IF (LGLOBRAD) THEN
  DO JF=1,NFLEVG+1
    CALL EMPTB(IWORDT,PAC(1,JF),THERRAD(1,:),&
     & ILENBT,ISTAGPTB,NPCKFTHR,NEXPBTHR)  
  ENDDO
ELSE
  DO JF=1,NFLEVG+1
    CALL EMPTB(IWORDT,PAC(1,JF),THERRAD(NLATRD,:),&
     & ILENBT,ISTAGPTB,NPCKFTHR,NEXPBTHR)  
  ENDDO
ENDIF

!       1.4  UPDATE FOR LATITUDE

IF (NLATRD == NLATWR) THEN
  NLATRD=0
ENDIF

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

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

