ac226f71409587a454176bd931fdca6fb8d4838d
[MNH-git_open_source-lfs.git] / src / SURFEX / io_buffn.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #######################################################
6       SUBROUTINE IO_BUFF_n(HREC,HACTION,OKNOWN)
7 !     #######################################################
8 !
9 !!****  *IO_BUFF_n* - function to check if the field has already been read/written
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!**  METHOD
15 !!    ------
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!      V. Masson   *Meteo France*      
31 !!
32 !!    MODIFICATIONS
33 !!    -------------
34 !!      Original    08/2007 
35 !-------------------------------------------------------------------------------
36 !
37 !*       0.    DECLARATIONS
38 !              ------------
39 !
40 USE MODD_IO_BUFF_n, ONLY : CREC, NREC
41 !
42 !
43 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
44 USE PARKIND1  ,ONLY : JPRB
45 !
46 IMPLICIT NONE
47 !
48 !*       0.1   Declarations of arguments
49 !              -------------------------
50 !
51  CHARACTER(LEN=12),  INTENT(IN) :: HREC     ! field to read or write
52  CHARACTER(LEN=1),   INTENT(IN) :: HACTION  ! 'R' : file being read
53                                            ! 'W' : file being written
54 !
55 LOGICAL,            INTENT(OUT):: OKNOWN   ! T : field has already been read/written
56 !
57 !*       0.2   Declarations of local variables
58 !              -------------------------------
59 !
60 INTEGER :: JLOOP
61 REAL(KIND=JPRB) :: ZHOOK_HANDLE
62 !-------------------------------------------------------------------------------
63 !
64 IF (LHOOK) CALL DR_HOOK('IO_BUFF_N',0,ZHOOK_HANDLE)
65 IF (HACTION=='R' .OR. HACTION=='W') THEN
66   OKNOWN=.FALSE.
67   DO JLOOP=1,NREC
68     OKNOWN=(HREC==CREC(JLOOP))
69     IF (OKNOWN .AND. LHOOK) CALL DR_HOOK('IO_BUFF_N',1,ZHOOK_HANDLE)
70     IF (OKNOWN) RETURN
71   END DO
72   NREC=NREC+1
73   CREC(NREC)=HREC
74 END IF
75 IF (LHOOK) CALL DR_HOOK('IO_BUFF_N',1,ZHOOK_HANDLE)
76 !
77 !-------------------------------------------------------------------------------
78 !
79 END SUBROUTINE IO_BUFF_n