MODULE PHY_DIAG_MOD

  !PHY_DIAG_MOD contains types and procedures to support easy creation 
  !of new diagnostic output from IFS. 
  !
  USE PARKIND1, ONLY: JPIM, JPRB

  IMPLICIT NONE

  !---public member functions
  PUBLIC NEW_DIAG_SET, NEW_DIAGNOSTIC, PRINT_DIAG_LIST
  PUBLIC RAD_EXTRA_DIAG, RESET_ACCUM_DIAG
  
  !---private member functions
  PRIVATE STORE_RAD_EXTRA_DIAG, WRITE_DIAG

  !---public derived datatypes
  TYPE, PUBLIC :: T_DIAG_SET
     CHARACTER(LEN=256) :: SET_NAME
     INTEGER(KIND=JPIM) :: NDIAG         ! Number of diagnostics in the linked list
     TYPE(T_DIAG), POINTER :: START      ! Start of the linked list of diagnostics in this set
  END TYPE T_DIAG_SET

  TYPE, PUBLIC :: T_DIAG
     TYPE(T_DIAG_SET) :: SET
     CHARACTER(LEN=256) :: DIAG_NAME          
     LOGICAL :: LACCUM                   ! T if the field is aggregated until output, then reset 
     LOGICAL :: LRAD                     ! T if the diagnostic is implemented within radiation
     INTEGER(KIND=JPIM) :: NDIM          ! 2 or 3 dimensional field
     INTEGER(KIND=JPIM) :: IGRIBCODE     
     INTEGER(KIND=JPIM) :: IXTR2         ! index within the PEXTR2 array, valid for all 2-D diagnostics
     INTEGER(KIND=JPIM) :: IXTRA         ! index within the PEXTRA array, valid for all 3-D diagnostics
     INTEGER(KIND=JPIM) :: IXRAD2D       ! index within ZEXTR2 in RADDRV and subsequent
                                         ! PEXTR2 field within the radiation code (for LRAD=T) 
     INTEGER(KIND=JPIM) :: IXRAD3D       ! index within ZEXTRA in RADDRV and subsequent
                                         ! PEXTRA field within the radiation code (for LRAD=T) 
     TYPE(T_DIAG), POINTER :: NEXT_DIAG
  END TYPE T_DIAG

  !---diagnostic set list
  INTEGER(KIND=JPIM), PARAMETER, PUBLIC :: JPMAXSETS=50
  TYPE(T_DIAG_SET), TARGET, PUBLIC :: DIAG_SET(JPMAXSETS) 

  !---number of defined sets
  INTEGER(KIND=JPIM), PRIVATE :: NDIAGSETS=0         ! number of defined diagnostic sets

  !---number of defined 2-D and 3-D fields
  INTEGER(KIND=JPIM), PUBLIC :: N2D=0                ! total 2-D fields
  INTEGER(KIND=JPIM), PUBLIC :: N3D=0                ! total 3-D fields
  INTEGER(KIND=JPIM), PUBLIC :: NRAD2D=0             ! 2-D fields with LRAD=T
  INTEGER(KIND=JPIM), PUBLIC :: NRAD3D=0             ! 3-D fields with LRAD=T

  CONTAINS
    
    !----------------------------------------------------------------------------------------------------
    SUBROUTINE NEW_DIAG_SET(CNAME, SET_HANDLE)

      !--- Purpose:
      !    NEW_DIAG_SET begins the definition of a set of diagnostic fields that are
      !    to be output to file. NEW_DIAG_SET defines the common properties of the set,
      !    so far only its name and the number of diagnostics in the set.
      !    After successful completion, the caller's handle to the set is the integer
      !    returned by the function. 
      !    This handle is then used to define the diagnostic fields contained in the set.
      !
      !    Arguments:-
      !    SET_HANDLE : type INTEGER, index to the new diagnostic set
      !    NAME : type CHARACTER, name for the requested diagnostic set

      !--- inherited types, functions and data
      USE YOMHOOK, ONLY: LHOOK, DR_HOOK

      IMPLICIT NONE

      !---subroutine interface
      CHARACTER(LEN=*),   INTENT(IN)  :: CNAME
      INTEGER(KIND=JPIM), INTENT(OUT) :: SET_HANDLE
      
      !---local data
      INTEGER(KIND=JPIM) :: I, JN
      REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

      !---executable procedure
      IF (LHOOK) CALL DR_HOOK('PHY_DIAG_MOD.NEW_DIAG_SET', 0, ZHOOK_HANDLE)

      IF (NDIAGSETS == JPMAXSETS) &
         & CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG_SET: Max. number of diagnostic sets already defined')

      !---check if name is already used
      DO JN = 1,NDIAGSETS
         IF (TRIM(CNAME) == TRIM(DIAG_SET(JN)%SET_NAME)) &
           & CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG_SET: List name '//TRIM(CNAME)//' already defined')
      END DO

      NDIAGSETS = NDIAGSETS+1
      I = NDIAGSETS
      SET_HANDLE = I
      DIAG_SET(I)%SET_NAME = CNAME
      DIAG_SET(I)%NDIAG = 0
      NULLIFY(DIAG_SET(I)%START)

      IF (LHOOK) CALL DR_HOOK('PHY_DIAG_MOD.NEW_DIAG_SET', 1, ZHOOK_HANDLE)
    END SUBROUTINE NEW_DIAG_SET
    !----------------------------------------------------------------------------------------------------

    !----------------------------------------------------------------------------------------------------
    SUBROUTINE NEW_DIAGNOSTIC(SET, CNAME, NDIM, NGRIBCODE, LACCUM, LRAD, DIAGPTR)

      !--- inherited types, functions and data
      USE YOMHOOK, ONLY: LHOOK, DR_HOOK
      USE YOMDPHY, ONLY: NVEXTR, NVXTR2, NVEXTRDYN
      USE YOMPHYDS, ONLY: NVEXTRAGB, NVEXTR2GB

      IMPLICIT NONE

      !---subroutine interface
      INTEGER(KIND=JPIM), INTENT(IN) :: SET          ! Index to the diagnostic set
      CHARACTER(LEN=*), INTENT(IN)   :: CNAME        ! Name for this diagnostic 
      INTEGER(KIND=JPIM), INTENT(IN) :: NDIM         ! Dimension of the diagnostic field (2 or 3)
      INTEGER(KIND=JPIM), INTENT(IN) :: NGRIBCODE    ! Grib code.
      LOGICAL, INTENT(IN)  :: LACCUM            ! Field is aggregated over time 
      LOGICAL, INTENT(IN)  :: LRAD              ! Diagnostic is implemented within radiation 
      TYPE(T_DIAG), POINTER :: DIAGPTR          ! pointer to the diagnostic

      !---local data
      TYPE(T_DIAG), POINTER :: NEW_DIAG, THIS_DIAG
      TYPE(T_DIAG_SET), POINTER :: THIS_SET
      INTEGER(KIND=JPIM) :: JN, IGRIBCODE, IVEXTR2, IVEXTRA
      LOGICAL :: LLMATCH
      CHARACTER(LEN=128) :: CERRSTR
      REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

      !---executable procedure
      IF (LHOOK) CALL DR_HOOK('PHY_DIAG_MOD.NEW_DIAG_2D', 0, ZHOOK_HANDLE)

      THIS_SET => DIAG_SET(SET)

      ! check that the set handle is valid
      IF (SET > NDIAGSETS) & 
        & CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG: ATTEMPT TO DEFINE DIAGNOSTIC IN AN UNDEFINED DIAGNOSTIC SET FOR '//TRIM(CNAME))

      ! check that the dimension is valid
      IF (.NOT.(NDIM == 2 .OR. NDIM==3)) &
        & CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG: NDIM MUST BE SET TO 2 OR 3 FOR '//TRIM(CNAME))

      ! check the grib code
      IF (NGRIBCODE < 1 .OR. (NGRIBCODE > 255 .AND. NGRIBCODE < 1001) &
            & .OR. (MOD(NGRIBCODE, 1000) > 255) .OR. MOD(NGRIBCODE,1000) == 0 &
            & .OR. NGRIBCODE >= 1000000) &         
            & CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG: ILLEGAL GRIB CODE FOR '//TRIM(CNAME))

      ! check for mismatch with NAMDPHY
      IF (NVEXTRDYN /= 0) THEN
         WRITE(CERRSTR,'(A)') 'NVEXTRDYN > 0 not allowed in combination with LDYNVAR=T, LACI_DIAG=T, L2RAD=T or COSP'
         CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG:'//TRIM(CERRSTR))
      END IF
      IF (NDIM==2 .AND. N2D == NVXTR2) THEN
         WRITE(CERRSTR,'(A,1X,A,2(1X,A,I0))') 'Maximum 2-D fields already defined. Defining ', & 
                                            & TRIM(CNAME), 'N2D=',N2D, 'NVXTR2=', NVXTR2
         CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG:'//TRIM(CERRSTR))
      END IF
      IF (NDIM==3 .AND. N3D == NVEXTR) THEN
         WRITE(CERRSTR,'(A,1X,A,2(1X,A,I0))') 'Maximum 3-D fields already defined. Defining ', &
                                            & TRIM(CNAME), 'N3D=',N3D, 'NVEXTR=', NVEXTR
         CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG:'//TRIM(CERRSTR))
      END IF

      ! check that the grib code is defined in NAMPHYDS
      IGRIBCODE = NGRIBCODE
      LLMATCH = .FALSE.
      ! for 2-D fields:
      IF (NDIM == 2) THEN
         DO JN=1,NVXTR2
            IF (IGRIBCODE == NVEXTR2GB(JN)) THEN
               LLMATCH = .TRUE.
               IVEXTR2 = JN
               EXIT
            END IF
         END DO
         IF (.NOT. LLMATCH) THEN
            WRITE(CERRSTR,'(A,1X,I0,1X,A)') 'GRIB CODE', NGRIBCODE, 'NOT FOUND NVEXTR2GB IN NAMPHYDS FOR '//TRIM(CNAME)
            CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG: '//TRIM(CERRSTR))
         END IF
      ! for 3-D fields:
      ELSE
         DO JN=1,NVEXTR
            IF (IGRIBCODE == NVEXTRAGB(JN)) THEN
               LLMATCH = .TRUE.
               IVEXTRA = JN
               EXIT
            END IF
         END DO
         IF (.NOT. LLMATCH) THEN
            WRITE(CERRSTR,'(A,1X,I0,1X,A)') 'GRIB CODE', NGRIBCODE, 'NOT FOUND NVEXTRAGB IN NAMPHYDS FOR '//TRIM(CNAME)
            CALL ABOR1('PHY_DIAG_MOD.NEW_DIAG: '//TRIM(CERRSTR))
         END IF
      END IF

      IF (.NOT. ASSOCIATED(THIS_SET%START) ) THEN   ! First diagnostic in the set
         ALLOCATE(NEW_DIAG)
         THIS_SET%START => NEW_DIAG
      ELSE                                          ! Find the end of the linked list,
         THIS_DIAG=>THIS_SET%START                  ! i.e last defined diagnostic in the set
         DO WHILE (ASSOCIATED(THIS_DIAG%NEXT_DIAG))
            THIS_DIAG => THIS_DIAG%NEXT_DIAG
         END DO
            
         ALLOCATE(NEW_DIAG)
         THIS_DIAG%NEXT_DIAG => NEW_DIAG
      END IF

      ! New diagnostic OK, set the data
      THIS_SET%NDIAG = THIS_SET%NDIAG + 1
      NEW_DIAG%DIAG_NAME = CNAME
      NEW_DIAG%NDIM = NDIM
      NEW_DIAG%IGRIBCODE = NGRIBCODE
      NULLIFY(NEW_DIAG%NEXT_DIAG)

      NEW_DIAG%LACCUM = LACCUM
      NEW_DIAG%LRAD = LRAD

      IF (NEW_DIAG%NDIM == 2) THEN
         N2D = N2D + 1
         NEW_DIAG%IXTR2 = IVEXTR2
         IF (NEW_DIAG%LRAD) THEN
            NRAD2D = NRAD2D + 1
            NEW_DIAG%IXRAD2D = NRAD2D
         END IF
      ELSE
         N3D = N3D + 1
         NEW_DIAG%IXTRA = IVEXTRA
         IF (NEW_DIAG%LRAD) THEN
            NRAD3D = NRAD3D + 1
            NEW_DIAG%IXRAD3D = NRAD3D
         END IF
      END IF

      DIAGPTR => NEW_DIAG
      
      IF (LHOOK) CALL DR_HOOK('PHY_DIAG_MOD.NEW_DIAG_2D', 1, ZHOOK_HANDLE)
      
    END SUBROUTINE NEW_DIAGNOSTIC

    !-----------------------------------------------------------------------------------
    SUBROUTINE RESET_ACCUM_DIAG(KIDIA, KFDIA, KLEV, KBL, LRAD)

      ! RESET_ACCUM_DIAG is called at each timestep by ec-phys (with LRAD=F) and at
      ! each radiation timestep by raddrv (with LRAD=T). RESET_ACCUM_DIAG checks 
      ! whether the accumulated diagnostics should be reset at this step, and if so
      ! traverses all diagnostic linked lists and resets those whose LRAD setting
      ! matches that of the calling subroutine.

      !--- inherited types, functions and data
      USE SURFACE_FIELDS_MIX, ONLY: SD_X2, SD_XA 
      USE YOMCT0, ONLY: NFRPOS
      USE YOMCT3, ONLY: NSTEP
      USE YOMHOOK, ONLY: LHOOK, DR_HOOK
      USE YOMLUN, ONLY:NULOUT

      IMPLICIT NONE

      !---subroutine interface
      !
      ! -   Input arguments
      !     ---------------
      ! KIDIA    : start point on the current row
      ! KFDIA    : end point on the current row
      ! KLEV     : number of model levels
      ! KBL      : current row number
      ! LRAD     : TRUE if called from radiation, FALSE if called from physics
      INTEGER(KIND=JPIM), INTENT(IN) :: KIDIA
      INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
      INTEGER(KIND=JPIM), INTENT(IN) :: KLEV
      INTEGER(KIND=JPIM), INTENT(IN) :: KBL
      LOGICAL, INTENT(IN) :: LRAD

      !---local data
      TYPE(T_DIAG), POINTER :: THIS_DIAG
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      INTEGER(KIND=JPIM) :: JN 

      !---exectuable procedure
      IF (LHOOK) CALL DR_HOOK('PHY_DIAG_MOD.RESET_ACCUM_DIAG',0,ZHOOK_HANDLE)

      IF (MOD(NSTEP,NFRPOS) == 0) THEN
         DO JN=1,NDIAGSETS
            IF (ASSOCIATED(DIAG_SET(JN)%START)) THEN
               THIS_DIAG => DIAG_SET(JN)%START

               ! Check if LRAD has same logical value as THIS_DIAG%LRAD
               IF  (THIS_DIAG%LACCUM .AND.(THIS_DIAG%LRAD .EQV. LRAD)) THEN                  
                  IF (THIS_DIAG%NDIM == 3) THEN
                     SD_XA(KIDIA:KFDIA,:,THIS_DIAG%IXTRA,KBL) = 0._JPRB
                  ELSE
                     SD_X2(KIDIA:KFDIA,THIS_DIAG%IXTR2,KBL) = 0._JPRB
                  END IF
               END IF

               DO WHILE (ASSOCIATED(THIS_DIAG%NEXT_DIAG))
                  THIS_DIAG => THIS_DIAG%NEXT_DIAG

                  ! Check if LRAD has same logical value as THIS_DIAG%LRAD
                  IF (THIS_DIAG%LACCUM .AND. (THIS_DIAG%LRAD .EQV. LRAD)) THEN
                     IF (THIS_DIAG%NDIM == 3) THEN
                        SD_XA(KIDIA:KFDIA,:,THIS_DIAG%IXTRA,KBL) = 0._JPRB
                     ELSE
                        SD_X2(KIDIA:KFDIA,THIS_DIAG%IXTR2,KBL) = 0._JPRB
                     END IF
                  END IF
               END DO

            END IF
         END DO
      END IF

      IF (LHOOK) CALL DR_HOOK('PHY_DIAG_MOD.RESET_ACCUM_DIAG',1,ZHOOK_HANDLE)
    END SUBROUTINE RESET_ACCUM_DIAG
    !-----------------------------------------------------------------------------------

    !-----------------------------------------------------------------------------------
    SUBROUTINE RAD_EXTRA_DIAG(KGPTOT, KLON, KSTGLO, KIDIA, KFDIA, KBL, PEXTRARAD, PEXTR2RAD, PMU0)

      ! RAD_EXTRA_DIAG is called at each radiation timestep from RADDRV.
      ! Its purpose is to store the radiation diagnostics that use PEXTR2/PEXTRA
      ! into those arrays for output, so that the high-level radiation driver RADDRV
      ! does not need to know about the specifics of each radiation diagnostic and
      ! how it needs to be handled.
      ! RAD_EXTRA_DIAG just sorts through the diagnostic linked lists, looking for
      ! radiation-side diagnostics (LRAD=T). The job of storing the data in PEXTRx
      ! is done in STORE_RAD_DIAG_EXTRA.

      !--- inherited types, functions and data
      USE SURFACE_FIELDS_MIX, ONLY: YSD_XAD
      USE YOMHOOK, ONLY: LHOOK, DR_HOOK
      USE YOMLUN, ONLY: NULOUT

      IMPLICIT NONE

      !---subroutine interface
      !
      ! -   Input arguments
      !     ---------------
      ! KGPTOT   : number of grid columns on this PE 
      ! KLON     : maximum size of grid rows on this PE 
      ! KSTGLO   : current column number
      ! KIDIA    : start point on the current row
      ! KFDIA    : end point on the current row
      ! KBL      : current row number
      ! PEXTRARAD: data for the 3-D radiation diagnostics (ZEXTRA in RADDRV)
      ! PEXTR2RAD: data for the 2-D radiation diagnostics (ZEXTR2 in RADDRV)
      ! PMU0     : solar zenith angle (used to correct for non-zero SW
      !            in night time

      INTEGER(KIND=JPIM), INTENT(IN) :: KGPTOT  
      INTEGER(KIND=JPIM), INTENT(IN) :: KLON
      INTEGER(KIND=JPIM), INTENT(IN) :: KSTGLO
      INTEGER(KIND=JPIM), INTENT(IN) :: KIDIA
      INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
      INTEGER(KIND=JPIM), INTENT(IN) :: KBL
      REAL(KIND=JPRB), INTENT(IN) :: PEXTRARAD(KGPTOT,YSD_XAD%NLEVS,NRAD3D)
      REAL(KIND=JPRB), INTENT(IN) :: PEXTR2RAD(KGPTOT,NRAD2D)
      REAL(KIND=JPRB), INTENT(IN) :: PMU0(KLON)

      !---local data
      TYPE(T_DIAG), POINTER :: THIS_DIAG
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      INTEGER(KIND=JPIM) :: JN

      !---exectuable procedure
      IF (LHOOK) CALL DR_HOOK('PHYS_DIAG_MOD.RAD_EXTRA_DIAG',0,ZHOOK_HANDLE)

      IF (NDIAGSETS > 0) THEN
         DO JN=1,NDIAGSETS
            IF (ASSOCIATED(DIAG_SET(JN)%START)) THEN
               THIS_DIAG => DIAG_SET(JN)%START

               IF (THIS_DIAG%LRAD) THEN
                  CALL STORE_RAD_EXTRA_DIAG(KGPTOT, KLON, KSTGLO, KIDIA, KFDIA, KBL, & 
                                          & PEXTRARAD, PEXTR2RAD, PMU0, THIS_DIAG)

               END IF
           
               ! Repeat for the rest of the linked list
               DO WHILE(ASSOCIATED(THIS_DIAG%NEXT_DIAG))
                  THIS_DIAG => THIS_DIAG%NEXT_DIAG

                  IF (THIS_DIAG%LRAD) THEN

                     CALL STORE_RAD_EXTRA_DIAG(KGPTOT, KLON, KSTGLO, KIDIA, KFDIA, KBL, & 
                                             & PEXTRARAD, PEXTR2RAD, PMU0, THIS_DIAG)
                  END IF
               END DO
           
            END IF            
         END DO               
      END IF                  
      
      IF (LHOOK) CALL DR_HOOK('PHYS_DIAG_MOD.RAD_EXTRA_DIAG',1,ZHOOK_HANDLE)
    END SUBROUTINE RAD_EXTRA_DIAG

    !-----------------------------------------------------------------------------------
    SUBROUTINE STORE_RAD_EXTRA_DIAG(KGPTOT, KLON, KSTGLO, KIDIA, KFDIA, KBL, & 
                                  & PEXTRARAD, PEXTR2RAD, PMU0, PDIAG)

      !--- inherited types, functions and data
      USE SURFACE_FIELDS_MIX, ONLY: SD_X2, SD_XA, YSD_XAD
      USE YOMDYN, ONLY: TSTEP
      USE YOERAD, ONLY: NRADFR
      USE YOMCT0, ONLY: NFRPOS
      USE YOMCT3, ONLY: NSTEP
      USE YOMHOOK, ONLY: LHOOK, DR_HOOK

      IMPLICIT NONE

      !---subroutine interface
      INTEGER(KIND=JPIM), INTENT(IN) :: KGPTOT
      INTEGER(KIND=JPIM), INTENT(IN) :: KLON
      INTEGER(KIND=JPIM), INTENT(IN) :: KSTGLO
      INTEGER(KIND=JPIM), INTENT(IN) :: KIDIA
      INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
      INTEGER(KIND=JPIM), INTENT(IN) :: KBL
      REAL(KIND=JPRB), INTENT(IN) :: PEXTRARAD(KGPTOT,YSD_XAD%NLEVS,NRAD3D)
      REAL(KIND=JPRB), INTENT(IN) :: PEXTR2RAD(KGPTOT,NRAD2D)
      REAL(KIND=JPRB), INTENT(IN) :: PMU0(KLON)
      TYPE(T_DIAG), POINTER :: PDIAG

      !---local data
      REAL(KIND=JPRB) :: ZACCTIME
      REAL(KIND=JPRB) :: ZACCUM
      REAL(KIND=JPRB) :: ZDAYNIGHT(KLON)
      LOGICAL :: LRESET
      LOGICAL :: LLW
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      INTEGER(KIND=JPIM) :: JL,JK,JN

      !---exectuable procedure
      IF (LHOOK) CALL DR_HOOK('PHYS_DIAG_MOD.STORE_RAD_EXTRA_DIAG',0,ZHOOK_HANDLE)

      ZACCTIME = TSTEP * REAL(NRADFR,JPRB)

      IF (PDIAG%LACCUM) THEN
         IF (PDIAG%NDIM == 3) THEN
            DO JK=1,YSD_XAD%NLEVS
               DO JL=KIDIA,KFDIA
                  SD_XA(JL,JK,PDIAG%IXTRA,KBL) = SD_XA(JL,JK,PDIAG%IXTRA,KBL) + & 
                             PEXTRARAD(KSTGLO+JL-1,JK,PDIAG%IXRAD3D) * ZACCTIME
               END DO
            END DO
         ELSE
            DO JL=KIDIA,KFDIA
               SD_X2(JL,PDIAG%IXTR2,KBL) = SD_X2(JL,PDIAG%IXTR2,KBL) + & 
                             PEXTR2RAD(KSTGLO+JL-1,PDIAG%IXRAD2D) * ZACCTIME
            END DO
         END IF
      ELSE 
         IF (PDIAG%NDIM == 3) THEN
            DO JK=1,YSD_XAD%NLEVS
               DO JL=KIDIA,KFDIA
                  SD_XA(JL,JK,PDIAG%IXTRA,KBL) = PEXTRARAD(KSTGLO+JL-1,JK,PDIAG%IXRAD3D) 
               END DO
            END DO
         ELSE
            DO JL=KIDIA,KFDIA
               SD_X2(JL,PDIAG%IXTR2,KBL) = PEXTR2RAD(KSTGLO+JL-1,PDIAG%IXRAD2D) 
            END DO
         END IF
      END IF

      IF (LHOOK) CALL DR_HOOK('PHYS_DIAG_MOD.STORE_RAD_EXTRA_DIAG',1,ZHOOK_HANDLE)
    END SUBROUTINE STORE_RAD_EXTRA_DIAG

    !-----------------------------------------------------------------------------------
    SUBROUTINE PRINT_DIAG_LIST(KULOUT)

      !--- inherited types, functions and data
      USE YOMHOOK,            ONLY: LHOOK, DR_HOOK

      IMPLICIT NONE

      !---subroutine interface
      INTEGER(KIND=JPIM), INTENT(IN) :: KULOUT

      !---local data
      TYPE(T_DIAG), POINTER :: THIS_DIAG
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      INTEGER(KIND=JPIM) :: JN

      !---exectuable procedure
      IF (LHOOK) CALL DR_HOOK('PHYS_DIAG_MOD.PRINT_DIAG_LIST',0,ZHOOK_HANDLE)

      WRITE(KULOUT,*) 'Diagnostics defined using PHY_DIAG_MOD'
      IF (NDIAGSETS==0) THEN 
         WRITE(KULOUT,*), 'None'
      ELSE
         WRITE(KULOUT,'(A,1X,I0)') 'Number of 2-D diagnostics:', N2D
         WRITE(KULOUT,'(A,1X,I0)') 'Number of 3-D diagnostics:', N3D
         WRITE(KULOUT,'(A,1X,I0)') 'Number of 2-D diagnostics in radiation:', NRAD2D
         WRITE(KULOUT,'(A,1X,I0)') 'Number of 3-D diagnostics in radiation:', NRAD3D
         WRITE(KULOUT,*) ''
      END IF

      DO JN=1,NDIAGSETS
         WRITE(KULOUT,*) 'Diagnostic set ', TRIM(DIAG_SET(JN)%SET_NAME)
         WRITE(KULOUT,*) ''
         IF (ASSOCIATED(DIAG_SET(JN)%START)) THEN
            THIS_DIAG => DIAG_SET(JN)%START
            CALL WRITE_DIAG(KULOUT, THIS_DIAG)
            DO WHILE (ASSOCIATED(THIS_DIAG%NEXT_DIAG))
               THIS_DIAG => THIS_DIAG%NEXT_DIAG
               CALL WRITE_DIAG(KULOUT, THIS_DIAG)
            END DO
         END IF
      END DO

      IF (LHOOK) CALL DR_HOOK('PHYS_DIAG_MOD.PRINT_DIAG_LIST',1,ZHOOK_HANDLE)
    END SUBROUTINE PRINT_DIAG_LIST

    SUBROUTINE WRITE_DIAG(KULOUT, PRTDIAG)
      !--- inherited types, functions and data
      USE YOMHOOK,            ONLY: LHOOK, DR_HOOK

      IMPLICIT NONE

      !---subroutine interface
      INTEGER(KIND=JPIM), INTENT(IN) :: KULOUT
      TYPE(T_DIAG), POINTER :: PRTDIAG

      !---local data
      INTEGER(KIND=JPIM) :: JN
      CHARACTER(LEN=8) :: CIXRAD
      REAL(KIND=JPRB) :: ZHOOK_HANDLE

      !---exectuable procedure
      IF (LHOOK) CALL DR_HOOK('PHY_DIAG_MOD.WRITE_DIAG',0,ZHOOK_HANDLE)
      
      WRITE(KULOUT,'(8X,A,1X,A)') 'Name:', TRIM(PRTDIAG%DIAG_NAME)
      WRITE(KULOUT,'(8X,A,1X,L1)') 'Accumulated:', PRTDIAG%LACCUM
      WRITE(KULOUT,'(8X,A,1X,L1)') 'Radiation diagnostic:', PRTDIAG%LRAD
      WRITE(KULOUT,'(8X,A,1X,I0)') 'Grib code:', PRTDIAG%IGRIBCODE
      IF (PRTDIAG%NDIM == 2) THEN
         WRITE(KULOUT,'(8X,A,1X,I0)') 'Index in PEXTR2:', PRTDIAG%IXTR2
         IF (PRTDIAG%LRAD) THEN
            WRITE(CIXRAD,'(I0)') PRTDIAG%IXRAD2D
         ELSE
            WRITE(CIXRAD,'(A)') '-'
         END IF
         WRITE(KULOUT,'(8X,A,1X,A)') 'Index in PEXTR2-rad:', TRIM(CIXRAD)
      ELSE
         WRITE(KULOUT,'(8X,A,1X,I0)') 'Index in PEXTRA:', PRTDIAG%IXTRA
         IF (PRTDIAG%LRAD) THEN
            WRITE(CIXRAD,'(I0)') PRTDIAG%IXRAD3D
         ELSE
            WRITE(CIXRAD,'(A)') '-'
         END IF
         WRITE(KULOUT,'(8X,A,1X,A)') 'Index in PEXTRA-rad:', TRIM(CIXRAD)
      END IF
      WRITE(KULOUT,*) ''
      
      IF (LHOOK) CALL DR_HOOK('PHYS_DIAG_MOD.WRITE_DIAG',1,ZHOOK_HANDLE)
    END SUBROUTINE WRITE_DIAG

END MODULE PHY_DIAG_MOD
