mode_fasurfex.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_fasurfex
!
  INTERFACE faecr
     MODULE PROCEDURE faecr_i
     MODULE PROCEDURE faecr_r
     MODULE PROCEDURE faecr_l
     MODULE PROCEDURE faecr_c
     MODULE PROCEDURE faecr_i_d
     MODULE PROCEDURE faecr_r_d
     MODULE PROCEDURE faecr_l_d
  END INTERFACE
!  
  INTERFACE falit
     MODULE PROCEDURE falit_i
     MODULE PROCEDURE falit_r
     MODULE PROCEDURE falit_l
     MODULE PROCEDURE falit_c
     MODULE PROCEDURE falit_i_d
     MODULE PROCEDURE falit_r_d
     MODULE PROCEDURE falit_l_d
  END INTERFACE
!
 CONTAINS
!
! #############################################################
  SUBROUTINE faecr_i(KREP,KN,CNOMC,KDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: kdata
!
    REAL(KIND=8), DIMENSION(1)        :: zdonne
    INTEGER                           :: il
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_I',0,zhook_handle)
!    
    zdonne(1)=REAL(kdata,8)
    il=SIZE(zdonne)
    CALL faisan(krep,kn,cnomc,zdonne,il)
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_I',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE faecr_i
!
! #############################################################
  SUBROUTINE faecr_i_d(KREP,KN,CNOMC,KSIZE,KDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: ksize
    INTEGER,DIMENSION(KSIZE),INTENT(IN):: kdata
!
    REAL(KIND=8),DIMENSION(KSIZE)      :: zdonne
    INTEGER                            :: i
    REAL(KIND=JPRB)                    :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_I_D',0,zhook_handle)
!    
    DO i=1,ksize
       zdonne(i)=REAL(KDATA(I),8)
    END DO
    CALL faisan(krep,kn,cnomc,zdonne,ksize)
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_I_D',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE faecr_i_d

! #############################################################
  SUBROUTINE faecr_r(KREP,KN,CNOMC,PDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    REAL,INTENT(IN)                   :: pdata
!
    REAL(KIND=8), DIMENSION(1)        :: zdonne
    INTEGER                           :: il
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_R',0,zhook_handle)
!    
    zdonne(1)=REAL(pdata,8)
    il=SIZE(zdonne)
    CALL faisan(krep,kn,cnomc,zdonne,il)
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_R',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE faecr_r
!
! #############################################################
  SUBROUTINE faecr_r_d(KREP,KN,CNOMC,KSIZE,PDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: ksize
    REAL,DIMENSION(KSIZE),INTENT(IN)  :: pdata
!
    REAL(KIND=8),DIMENSION(KSIZE)     :: zdonne
    INTEGER                           :: i
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_R_D',0,zhook_handle)
!    
    DO i=1,ksize
       zdonne(i)=REAL(PDATA(I),8)
    END DO
    CALL faisan(krep,kn,cnomc,zdonne,ksize)
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_R_D',1,zhook_handle)   
!-------------------------------------------------------------------------------
!
  END SUBROUTINE faecr_r_d
!
! #############################################################
  SUBROUTINE faecr_l(KREP,KN,CNOMC,LDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    LOGICAL,INTENT(IN)                :: ldata
!
    REAL(KIND=8),DIMENSION(1)         :: zdonne
    INTEGER                           :: il
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_L',0,zhook_handle)
!    
    IF (ldata) THEN 
      zdonne(1)=1.
    ELSE
      zdonne(1)=0.
    ENDIF
    il=SIZE(zdonne)
    CALL faisan(krep,kn,cnomc,zdonne,il)
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_L',1,zhook_handle)   
!-------------------------------------------------------------------------------
!
  END SUBROUTINE faecr_l
!
! #############################################################
  SUBROUTINE faecr_l_d(KREP,KN,CNOMC,KSIZE,LDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: ksize
    LOGICAL,DIMENSION(KSIZE),INTENT(IN) :: ldata
!
    REAL(KIND=8),DIMENSION(KSIZE)     :: zdonne
    INTEGER                           :: i
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_L_D',0,zhook_handle)
!    
    DO i=1,ksize
       IF (ldata(i)) THEN 
          zdonne(i)=1.
       ELSE
          zdonne(i)=0.
       ENDIF
    END DO
    CALL faisan(krep,kn,cnomc,zdonne,ksize)
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_L_D',1,zhook_handle)   
!-------------------------------------------------------------------------------
!
  END SUBROUTINE faecr_l_d
!
! #############################################################
  SUBROUTINE faecr_c(KREP,KN,CNOMC,KSIZE,CDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: ksize
    CHARACTER,DIMENSION(KSIZE),INTENT(IN) :: cdata
!
    REAL(KIND=8),DIMENSION(KSIZE)     :: zdonne
    INTEGER                           :: i
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_C',0,zhook_handle)
!    
    DO i=1,ksize
       zdonne(i)=REAL(ICHAR(CDATA(I)),8)
    END DO
    CALL faisan(krep,kn,cnomc,zdonne,ksize)
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FAECR_C',1,zhook_handle)   
!-------------------------------------------------------------------------------
!
  END SUBROUTINE faecr_c
!
! #############################################################
  SUBROUTINE falit_i_d(KREP,KN,CNOMC,KSIZE,KDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: ksize
    INTEGER,DIMENSION(KSIZE),INTENT(OUT) :: kdata
!
    REAL(KIND=8),DIMENSION(KSIZE)     :: zdonne
    INTEGER                           :: i
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_I_D',0,zhook_handle)
!    
    CALL falais(krep,kn,cnomc,zdonne,ksize)
    DO i=1,ksize
       kdata(i)=anint(zdonne(i),kind(kdata))
    END DO
!
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_I_D',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE falit_i_d 
!
! #############################################################
  SUBROUTINE falit_i(KREP,KN,CNOMC,KDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(OUT)               :: kdata
!
    REAL(KIND=8), DIMENSION(1)        :: zdonne
    INTEGER                           :: il
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_I',0,zhook_handle)
!    
    il=SIZE(zdonne)
    CALL falais(krep,kn,cnomc,zdonne,il)
    kdata=anint(zdonne(1),kind(kdata))
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_I',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE falit_i 
!
! #############################################################
  SUBROUTINE falit_r_d(KREP,KN,CNOMC,KSIZE,PDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: ksize
    REAL,DIMENSION(KSIZE),INTENT(OUT) :: pdata
!
    REAL(KIND=8),DIMENSION(KSIZE)     :: zdonne
    INTEGER                           :: i
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_R_D',0,zhook_handle)
!    
    CALL falais(krep,kn,cnomc,zdonne,ksize)
    DO i=1,ksize
       pdata(i)=REAL(ZDONNE(I),kind(pdata))
    END DO
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_R_D',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE falit_r_d
!
! #############################################################
  SUBROUTINE falit_r(KREP,KN,CNOMC,PDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    REAL,INTENT(OUT)                  :: pdata
!
    REAL(KIND=8), DIMENSION(1)        :: zdonne
    INTEGER                           :: il
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_R',0,zhook_handle)
!    
    il=SIZE(zdonne)
    CALL falais(krep,kn,cnomc,zdonne,il)
    pdata=REAL(ZDONNE(1),kind(pdata))
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_R',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE falit_r
!
! #############################################################
  SUBROUTINE falit_l_d(KREP,KN,CNOMC,KSIZE,LDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: ksize
    LOGICAL,DIMENSION(KSIZE),INTENT(OUT)  :: ldata
!
    REAL(KIND=8),DIMENSION(KSIZE)     :: zdonne
    INTEGER                           :: i
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_L_D',0,zhook_handle)
!    
    CALL falais(krep,kn,cnomc,zdonne,ksize)
    DO i=1,ksize
       ldata(i)=LOGICAL(zdonne(i)==1.,kind(ldata))
    END DO
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_L_D',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE falit_l_d 
!
! #############################################################
  SUBROUTINE falit_l(KREP,KN,CNOMC,LDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
!
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    LOGICAL,INTENT(OUT)               :: ldata
!
    REAL(KIND=8), DIMENSION(1)        :: zdonne
    INTEGER                           :: il
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_L',0,zhook_handle)
!    
    il=SIZE(zdonne)
    CALL falais(krep,kn,cnomc,zdonne,il)
    ldata=LOGICAL(zdonne(1)==1.,kind(ldata))
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_L',1,zhook_handle)
!-------------------------------------------------------------------------------
!
  END SUBROUTINE falit_l 
!
! #############################################################
  SUBROUTINE falit_c(KREP,KN,CNOMC,KSIZE,CDATA)
! #############################################################
!
    USE yomhook   ,ONLY : lhook,   dr_hook
    USE parkind1  ,ONLY : jprb
!
    IMPLICIT NONE
!
    INTEGER,INTENT(INOUT)             :: krep
    INTEGER,INTENT(IN)                :: kn
    CHARACTER(LEN=18),INTENT(IN)      :: cnomc
    INTEGER,INTENT(IN)                :: ksize
    CHARACTER,DIMENSION(KSIZE),INTENT(OUT)  :: cdata
!
    REAL(KIND=8),DIMENSION(KSIZE)     :: zdonne
    INTEGER                           :: i,j
    REAL(KIND=JPRB)                   :: zhook_handle
!
!-------------------------------------------------------------------------------
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_C',0,zhook_handle)
!    
    CALL falais(krep,kn,cnomc,zdonne,ksize)
    DO i=1,ksize
       j=anint(zdonne(i))
       cdata(i)=char(j)
    END DO
!    
    IF (lhook) CALL dr_hook('MODE_FASURFEX:FALIT_C',1,zhook_handle)    
!-------------------------------------------------------------------------------
!    
  END SUBROUTINE falit_c
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
END MODULE mode_fasurfex