mode_write_surf_cov.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.

MODULE mode_write_surf_cov

!RJ: split cover from read_surf.F90 to avoid compiler bugs
!RJ: all safety compatibility checks should be done here
PUBLIC :: write_surf_cov

 CONTAINS

!     #############################################################
      SUBROUTINE write_surf_cov (DGU, U, &
                                 hprogram,hrec,pfield,oflag,kresp,hcomment,hdir)
!     #############################################################
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modi_write_surf, ONLY: write_surf
#ifdef SFX_MNH
USE modi_write_surfx2cov_mnh
#endif
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),     INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),     INTENT(IN)  :: hrec     ! name of the article to be read
REAL, DIMENSION(:,:), INTENT(IN)  :: pfield   ! array containing the data field
LOGICAL,DIMENSION(:), INTENT(IN)  :: oflag  ! mask for array filling
INTEGER,              INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),   INTENT(IN)  :: hcomment ! Comment string
 CHARACTER(LEN=1),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=12)  :: yrec
 CHARACTER(LEN=100) :: ycomment
INTEGER            :: il1
INTEGER            :: il2
 CHARACTER(LEN=1)   :: ydir
INTEGER            :: jcover, icover
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('WRITE_SURF_COV',0,zhook_handle)
!
yrec = hrec
ydir = 'H'
IF (present(hdir)) ydir = hdir
il1  = SIZE(pfield,1)
il2  = SIZE(oflag)
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
    CALL write_surfx2cov_mnh(yrec,il1,il2,pfield,oflag,kresp,hcomment,ydir)
#endif
ELSE
  !
!RJ: could be generalized for all
  IF (hprogram=='LFI   ') THEN
    yrec = 'COVER_PACKED'
    ycomment='-'
!!    YCOMMENT=HCOMMENT
    CALL write_surf(dgu, u, &
                    hprogram,yrec,.false.,kresp,ycomment)
  ENDIF
  !
  icover=0
  DO jcover=1,il2
    !
    WRITE(yrec,'(A5,I3.3)') 'COVER',jcover
    ycomment='X_Y_'//yrec
    IF (.NOT. oflag(jcover)) cycle
    icover = icover+1
    !
    CALL write_surf(dgu, u, &
                    hprogram,yrec,pfield(:,icover),kresp,ycomment,ydir)
    !
  END DO
END IF
!
IF (lhook) CALL dr_hook('WRITE_SURF_COV',1,zhook_handle)
!
END SUBROUTINE write_surf_cov

END MODULE mode_write_surf_cov