SURFEX v7.3
General documentation of Surfex
|
00001 ! ####################################################### 00002 SUBROUTINE IO_BUFF_n(HREC,HACTION,OKNOWN) 00003 ! ####################################################### 00004 ! 00005 !!**** *IO_BUFF_n* - function to check if the field has already been read/written 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! EXTERNAL 00014 !! -------- 00015 !! 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! 00024 !! AUTHOR 00025 !! ------ 00026 !! V. Masson *Meteo France* 00027 !! 00028 !! MODIFICATIONS 00029 !! ------------- 00030 !! Original 08/2007 00031 !------------------------------------------------------------------------------- 00032 ! 00033 !* 0. DECLARATIONS 00034 ! ------------ 00035 ! 00036 USE MODD_IO_BUFF_n, ONLY : CREC, NREC 00037 ! 00038 ! 00039 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00040 USE PARKIND1 ,ONLY : JPRB 00041 ! 00042 IMPLICIT NONE 00043 ! 00044 !* 0.1 Declarations of arguments 00045 ! ------------------------- 00046 ! 00047 CHARACTER(LEN=12), INTENT(IN) :: HREC ! field to read or write 00048 CHARACTER(LEN=1), INTENT(IN) :: HACTION ! 'R' : file being read 00049 ! 'W' : file being written 00050 ! 00051 LOGICAL, INTENT(OUT):: OKNOWN ! T : field has already been read/written 00052 ! 00053 !* 0.2 Declarations of local variables 00054 ! ------------------------------- 00055 ! 00056 INTEGER :: JLOOP 00057 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00058 !------------------------------------------------------------------------------- 00059 ! 00060 IF (LHOOK) CALL DR_HOOK('IO_BUFF_N',0,ZHOOK_HANDLE) 00061 IF (HACTION=='R' .OR. HACTION=='W') THEN 00062 OKNOWN=.FALSE. 00063 DO JLOOP=1,NREC 00064 OKNOWN=(HREC==CREC(JLOOP)) 00065 IF (OKNOWN .AND. LHOOK) CALL DR_HOOK('IO_BUFF_N',1,ZHOOK_HANDLE) 00066 IF (OKNOWN) RETURN 00067 END DO 00068 NREC=NREC+1 00069 CREC(NREC)=HREC 00070 END IF 00071 IF (LHOOK) CALL DR_HOOK('IO_BUFF_N',1,ZHOOK_HANDLE) 00072 ! 00073 !------------------------------------------------------------------------------- 00074 ! 00075 END SUBROUTINE IO_BUFF_n