!     ##################
      MODULE DDH_MIX
!     ##################


!!    PURPOSE
!!    -------
!       module for type structure in  DDH  

!!**  IMPLICIT ARGUMENTS
!!    ------------------

!!    AUTHOR
!!    ------
!!	O.Riviere   *Meteo France*
!-------------------------------------------------------------------------------


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

IMPLICIT NONE

SAVE


!*       1.   TYPE DEFINITION


TYPE DDHFLEX
  CHARACTER(LEN=11)::CNAME !name of field 
  CHARACTER(LEN=1)::CFLUX !'F' if flux 'V' if variable 'T' if tendency
  CHARACTER(LEN=3)::CMOD  ! 'ARP','ARO': name of model
  LOGICAL:: LKDDH !TRUE if to be stored into DDH
  
! rfield has to be a pointer because allocatable not allowed in structure type
  REAL(KIND=JPRB),DIMENSION(:,:),POINTER:: RFIELD  ! value of retrieved field
  INTEGER(KIND=JPIM):: NFIELDIND! position of flux in ddh array 
END TYPE DDHFLEX


!*       2.   DECLARATIONS

REAL(KIND=JPRB),DIMENSION(:,:,:),ALLOCATABLE,TARGET::RDDH_FIELD
! ddh_field is the target of rfield
 
TYPE(DDHFLEX),ALLOCATABLE,DIMENSION(:):: RDDH_DESCR ! array of several structure type
INTEGER(KIND=JPIM):: NFLEVGDDH=0   ! number of processed field
INTEGER(KIND=JPIM):: NPROMADDH=0   ! number of processed field
INTEGER(KIND=JPIM):: NFIELDDDH=0   ! number of processed field
INTEGER(KIND=JPIM):: NTOTFIELD=0 !nb of fields in structure
INTEGER(KIND=JPIM):: NTOTVAR=0 ! nb of var. in structure
LOGICAL,DIMENSION(:),ALLOCATABLE:: LMASKDDH ! mask for operations in ddh operators
CHARACTER(LEN=13)::CNAMEINI ! name of first field                                           
LOGICAL:: LALLOC=.FALSE.  !if TRUE allocation of arrrays completed 

CONTAINS

!-----------------------------------------------
!*       3.   SUBROUTINES
!-----------------------------------------------

!-----------------------------------------------
! SUBROUTINE ADD_FIELD_3D
! allocates on the fly the flexible DDH structure
! during first time step and then stores the 
! velues of retrieved fields into it
! PMAT= Value of field to retrieve 
! CDNAME= Name of field
! CDFLUX='F','V','T' if flux,variable or tendency
! LDINST=TRUE if instantaneous field
! LDDH=TRUE if field to be stored into ddh files


SUBROUTINE ADD_FIELD_3D(PMAT,CDNAME,CDFLUX,CDMOD,LDINST,LDDH)
REAL(KIND=JPRB),DIMENSION(:,:),INTENT(IN) :: PMAT
CHARACTER(LEN=*),INTENT(IN)::CDNAME
CHARACTER(LEN=1),INTENT(IN):: CDFLUX                                         
CHARACTER(LEN=3),INTENT(IN):: CDMOD 
LOGICAL,INTENT(IN)::LDINST,LDDH                                         
REAL(KIND=JPRB),DIMENSION(:,:,:),ALLOCATABLE::ZDDH_FIELD_BKP
INTEGER(KIND=JPIM)::IDIM1,IDIM2,IDIM3,ITEST
TYPE(DDHFLEX),ALLOCATABLE,DIMENSION(:):: YLDDH_DESCR_BKP                                             
		      
#include "abor1.intfb.h"

!IF (LHOOK) CALL DR_HOOK('ADD_FIELD_3D',0,ZHOOK_HANDLE)


IF(LALLOC) THEN
  ITEST=NFIELDDDH+1
  IF(NFIELDDDH==NTOTFIELD) ITEST=NFIELDDDH+1-NTOTFIELD
  IF(CDNAME /= RDDH_DESCR(ITEST)%CNAME) THEN
    WRITE(NULOUT,*) 'PB NOMS ADD_FIELD3D ',CDNAME,' vs ',RDDH_DESCR(ITEST)%CNAME
    CALL ABOR1('ADD_FIELD_3D')
  ENDIF
ENDIF

IF(.NOT.LALLOC) THEN
  IF (CNAMEINI == CDNAME) THEN
    LALLOC=.TRUE.
  ENDIF
ENDIF
   
IF (LALLOC .AND. NFIELDDDH == NTOTFIELD) THEN
  NFIELDDDH=NFIELDDDH-NTOTFIELD       
  RDDH_FIELD(:,:,:)=0.0
ENDIF

        
        
IDIM1=NPROMADDH

IDIM2=NFLEVGDDH+1! arrays are stored on (nflevg+1) levels
                 ! with eventually last level equal to zero
                 ! for tendencies and variables

        
IF (.NOT.LALLOC) THEN ! (re-)allocation of arrays
  NTOTFIELD=NTOTFIELD+1 !updates total number of fields                                         
  IF(CDFLUX=='V') NTOTVAR=NTOTVAR+1 

  IF (NFIELDDDH == 0)  THEN
    ALLOCATE(RDDH_DESCR(1))                                    
  
    
    ALLOCATE(RDDH_FIELD(IDIM1,IDIM2,1))
    RDDH_FIELD(:,:,:)=0.
    CNAMEINI=CDNAME ! stores name of first field                                     
    IDIM3=0

  ELSE !NFIELDDDH=0                                         
        ! add a field to rddh_descr
    ALLOCATE(YLDDH_DESCR_BKP(NFIELDDDH))
    YLDDH_DESCR_BKP=RDDH_DESCR
    DEALLOCATE(RDDH_DESCR)
    ALLOCATE(RDDH_DESCR(NFIELDDDH+1))
    RDDH_DESCR(1:NFIELDDDH)=YLDDH_DESCR_BKP(1:NFIELDDDH)
    DEALLOCATE(YLDDH_DESCR_BKP)
    
    IDIM3=SIZE(RDDH_FIELD,3) 
    ! reallocation of rddh_field in order to increase dimension
    ALLOCATE(ZDDH_FIELD_BKP(IDIM1,IDIM2,IDIM3))
    ZDDH_FIELD_BKP=RDDH_FIELD ! temporary bkp of rddh_field 
    DEALLOCATE(RDDH_FIELD)
    ALLOCATE(RDDH_FIELD(IDIM1,IDIM2,IDIM3+1)) !one field added 
    RDDH_FIELD(:,:,:)=0.0
    RDDH_FIELD(1:IDIM1,1:IDIM2,1:IDIM3)=ZDDH_FIELD_BKP(1:IDIM1,1:IDIM2,1:IDIM3) 
    DEALLOCATE(ZDDH_FIELD_BKP)                                            
        
  ENDIF !NFIELDDDH=0
  
  IF (CDFLUX =='F') THEN 
    RDDH_FIELD(1:SIZE(PMAT,1),1:IDIM2,IDIM3+1)=PMAT(1:SIZE(PMAT,1),1:IDIM2) !stores new flux
  ELSE   
    RDDH_FIELD(1:SIZE(PMAT,1),1:IDIM2-1,IDIM3+1)=PMAT(1:SIZE(PMAT,1),1:IDIM2-1) !stores new tend/var
    RDDH_FIELD(1:SIZE(PMAT,1),IDIM2,IDIM3+1)=0.0
  ENDIF

  ! stores new attributes
  RDDH_DESCR(NFIELDDDH+1)%CNAME=CDNAME                    
  RDDH_DESCR(NFIELDDDH+1)%CMOD=CDMOD
  RDDH_DESCR(NFIELDDDH+1)%CFLUX=CDFLUX
  RDDH_DESCR(NFIELDDDH+1)%LKDDH=LDDH

  ALLOCATE(RDDH_DESCR(NFIELDDDH+1)%RFIELD(IDIM1,IDIM2))                                                     
  RDDH_DESCR(NFIELDDDH+1)%RFIELD=> RDDH_FIELD(1:IDIM1,1:IDIM2,IDIM3+1)        
  RDDH_DESCR(NFIELDDDH+1)%NFIELDIND=NFIELDDDH+1        

ELSE 
                
!-------------------------------


  IF (CDFLUX =='F') THEN 
    RDDH_FIELD(1:SIZE(PMAT,1),1:SIZE(RDDH_FIELD,2),NFIELDDDH+1)=PMAT(1:SIZE(PMAT,1),1:SIZE(RDDH_FIELD,2))     
  ELSE
    RDDH_FIELD(1:SIZE(PMAT,1),1:SIZE(RDDH_FIELD,2)-1,NFIELDDDH+1)=PMAT(1:SIZE(PMAT,1),1:SIZE(RDDH_FIELD,2)-1) 
    RDDH_FIELD(1:SIZE(PMAT,1),SIZE(RDDH_FIELD,2),NFIELDDDH+1)=0.0
  ENDIF
        
  RDDH_DESCR(NFIELDDDH+1)%RFIELD => RDDH_FIELD(:,:,NFIELDDDH+1)        

ENDIF



NFIELDDDH=NFIELDDDH+1                                             

!IF (LHOOK) CALL DR_HOOK('ADD_FIELD_3D',1,ZHOOK_HANDLE)

END SUBROUTINE ADD_FIELD_3D


!-*------------------------------------------
! INITIALISE ET DESALLOUE LES STRUCTURES DDH

SUBROUTINE RESET_DDHFLEX
  
!IF (LHOOK) CALL DR_HOOK('RESET_DDHFLEX',0,ZHOOK_HANDLE)
IF(ALLOCATED(RDDH_DESCR)) DEALLOCATE(RDDH_DESCR)
IF(ALLOCATED(RDDH_FIELD)) DEALLOCATE(RDDH_FIELD)
NFIELDDDH=0
NTOTFIELD=0
NTOTVAR=0
CNAMEINI='XXXXXXXXX'
LALLOC=.FALSE.
!IF (LHOOK) CALL DR_HOOK('RESET_DDH_FLEX',1,ZHOOK_HANDLE)
  
END SUBROUTINE RESET_DDHFLEX


!------------------------------------------------      
! creates the mask needed for computation on DDH ARRAYS
! mask has same dimension than pddhcv in ppsydh
! namely (nflevg+1)*(ndhcvsu+ndhvv)
! or (nflevg+1)*(ntotfield+ntotvar) within new struct.

SUBROUTINE MK_MASK
INTEGER(KIND=JPIM)::JFIELD

ALLOCATE(LMASKDDH((NTOTFIELD+NTOTVAR)*(NFLEVGDDH+1)))
LMASKDDH(:)=.FALSE.
DO JFIELD=1,NTOTFIELD
  IF(RDDH_DESCR(JFIELD)%CFLUX=='V') THEN
    LMASKDDH((JFIELD-1)*(NFLEVGDDH+1)+1:JFIELD*(NFLEVGDDH+1))=.TRUE.
  ENDIF
ENDDO

! variables at initial time  
LMASKDDH(NTOTFIELD*(NFLEVGDDH+1)+1:(NTOTFIELD+NTOTVAR)*(NFLEVGDDH+1))=.TRUE.  

END SUBROUTINE MK_MASK 

!*----------------------------
!stores nlon,nflevg into module

SUBROUTINE SUDDHFLEX(KPROMA,KLEV)
INTEGER(KIND=JPIM)::KPROMA,KLEV

NFLEVGDDH=KLEV
NPROMADDH=KPROMA

END SUBROUTINE SUDDHFLEX
!------------------------------------------------      
END MODULE DDH_MIX

