SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/test_record

Go to the documentation of this file.
00001 SUBROUTINE TEST_RECORD_LEN(HPROGRAM,HREC,ONOWRITE)
00002 !
00003 USE MODI_GET_LUOUT
00004 USE MODD_DIAG_SURF_ATM_n,  ONLY : LSELECT, CSELECT
00005 !
00006 !
00007 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00008 USE PARKIND1  ,ONLY : JPRB
00009 !
00010 USE MODI_ABOR1_SFX
00011 !
00012 IMPLICIT NONE
00013 !
00014  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM ! calling program
00015  CHARACTER(LEN=12),  INTENT(IN)  :: HREC     ! name of the article to be written
00016 LOGICAL,            INTENT(OUT) :: ONOWRITE ! flag for article to be written
00017 !
00018  CHARACTER(LEN=12) :: YREC
00019 INTEGER :: IFIELD,JFIELD
00020 INTEGER :: ILUOUT  ! listing logical unit
00021 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00022 !-------------------------------------------------------------------------------
00023 IF (LHOOK) CALL DR_HOOK('MODI_WRITE_SURF:TEST_RECORD_LEN',0,ZHOOK_HANDLE)
00024 IF (LEN_TRIM(HREC)>12) THEN
00025   CALL GET_LUOUT(HPROGRAM,ILUOUT)
00026   WRITE(ILUOUT,*) '----------------------------------------------'
00027   WRITE(ILUOUT,*) 'Error occured when writing a field            '
00028   WRITE(ILUOUT,*) 'The name of the field is too long             '
00029   WRITE(ILUOUT,*) 'The name must not be longer than 12 characters'
00030   WRITE(ILUOUT,*) 'Please shorten the name of your field         '
00031   WRITE(ILUOUT,FMT='(A32,A12,A1)') ' The field name currently is : "',HREC,'"'
00032   WRITE(ILUOUT,*) '----------------------------------------------'
00033   CALL ABOR1_SFX('TEST_RECORD_LEN: FIELD NAME TOO LONG --> '//HREC)
00034 END IF
00035 !
00036 YREC = HREC
00037 SELECT CASE(HREC(1:4))
00038 CASE("TEB1","TEB2","TEB3","TEB4","TEB5","TEB6","TEB7","TEB8","TEB9")
00039         YREC=HREC(6:LEN(HREC))
00040 END SELECT
00041 ! if output fields selection is active, test if this field is to be written
00042 IF (LSELECT)  THEN
00043    IFIELD=COUNT(CSELECT /= '            ')
00044    ONOWRITE=.TRUE.
00045    DO JFIELD=1,IFIELD
00046       IF ( TRIM(CSELECT(JFIELD))==TRIM(YREC) ) THEN
00047          ONOWRITE=.FALSE.
00048       ENDIF
00049    ENDDO
00050 ELSE
00051    ONOWRITE=.FALSE.
00052 ENDIF
00053 IF (LHOOK) CALL DR_HOOK('MODI_WRITE_SURF:TEST_RECORD_LEN',1,ZHOOK_HANDLE)
00054 !
00055 !-------------------------------------------------------------------------------
00056 END SUBROUTINE TEST_RECORD_LEN