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
!
INTERFACE write_surf_cov
  MODULE PROCEDURE write_surf_cov
END INTERFACE
!
CONTAINS
!
!     #############################################################
      SUBROUTINE write_surf_cov (HSELECT, &
                                 HPROGRAM,HREC,PFIELD,OFLAG,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio
!
USE modi_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
!
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
 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=16)  :: YREC2
 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(pfield,2)
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
    yrec2 = yrec
    CALL write_surfx2cov_mnh(yrec2,il1,il2,pfield,oflag,kresp,hcomment,ydir)
#endif
ELSE
  !
!RJ: could be generalized for all
  IF (nrank==npio) THEN
    IF (hprogram=='LFI   ') THEN
      yrec = 'COVER_PACKED'
      ycomment='-'
!!    YCOMMENT=HCOMMENT
      CALL write_surf(hselect,hprogram,yrec,.false.,kresp,ycomment)
    ENDIF
  ENDIF
  !
  icover=0
  DO jcover=1,SIZE(oflag)
    !
    WRITE(yrec,'(A5,I3.3)') 'COVER',jcover
    ycomment='X_Y_'//yrec
    IF (.NOT. oflag(jcover)) cycle
    icover = icover+1
    !
    CALL write_surf(hselect, 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