get_iok_assim.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.
SUBROUTINE get_iok_assim(HREC,KOK)
!
USE modd_assim, ONLY : cvar, cobs, cbio
!
USE yomhook ,ONLY : lhook, dr_hook
USE parkind1 ,ONLY : jprb
!
IMPLICIT NONE
!
 CHARACTER(LEN=16), INTENT(IN) :: hrec
INTEGER, INTENT(OUT) :: kok
!
INTEGER :: ilen
INTEGER :: j
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('GET_IOK_ASSIM',0,zhook_handle)
!
kok = 0
!
DO j = 1,SIZE(cvar)
  ilen = len_trim(cvar(j))
  IF (trim(hrec(1:ilen))==trim(cvar(j))) THEN
    kok = 1
    EXIT
  ENDIF
ENDDO
!
IF (kok==0) THEN
  DO j = 1,SIZE(cobs)   
    ilen = len_trim(cobs(j)) 
    IF (trim(hrec(1:ilen))==trim(cobs(j))) THEN
      kok = 1
      EXIT
    ENDIF
  ENDDO
ENDIF
!
IF (kok==0) THEN
  ilen = len_trim(cbio)
  IF (trim(hrec(1:ilen))==trim(cbio)) kok=1
ENDIF
!
IF (kok==0) THEN
  IF (hrec(1:4)=="WGI1") kok=1
ENDIF
!
IF (lhook) CALL dr_hook('GET_IOK_ASSIM',1,zhook_handle)
!
END SUBROUTINE get_iok_assim