SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/FM/fm

Go to the documentation of this file.
00001 !     ######spl
00002       SUBROUTINE FM_READ(HFILEM,HRECFM,HFIPRI,KLENG,KFIELD,KGRID,&
00003                         KLENCH,HCOMMENT,KRESP)
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 !     ###########################################################
00007 !
00008 !!****  *FM_READ* - routine to read a single data article in a "FM"-file
00009 !!
00010 !!    PURPOSE
00011 !!    -------
00012 !
00013 !       The purpose of FMREAD is to read one single article of data in
00014 !     a Meso-nh file. This routine only holds for LFI-files (not namelists)
00015 !
00016 !!**  METHOD
00017 !!    ------
00018 !!
00019 !!      The unformatted fortran read operation is actually executed in the
00020 !!    routine LFILEC. You just need to indicate the name of the file
00021 !!    without the ".lfi" suffix,
00022 !!    and the name of the article you want to read, as well as the length of
00023 !!    the field. LFILEC then knows how
00024 !!    to get the record number of the desired field by referring to an intern
00025 !!    table of association.
00026 !!      In FMREAD, the data is first stored in IWORK and then split in KGRID
00027 !!    (IWORK(1)=C-grid indicator) and KFIELD (integer or real data field)
00028 !!    which are both stored on the same LFI logical article.
00029 !!
00030 !!    EXTERNAL
00031 !!    --------
00032 !!
00033 !!      FMLOOK,LFINFO,LFILEC,CHAR
00034 !!
00035 !!    IMPLICIT ARGUMENTS
00036 !!    ------------------
00037 !!
00038 !!      MODULE: MODD_FMDECLAR contains management parameters and
00039 !!              storage arrays to move information around at the
00040 !!              level of all "FM"-routines.
00041 !!
00042 !!    REFERENCE
00043 !!    ---------
00044 !!
00045 !!      see the Technical Specifications Report for the Meso-nh project
00046 !!      (in French)
00047 !!
00048 !!    AUTHOR
00049 !!    ------
00050 !!
00051 !!      C. FISCHER      *METEO-FRANCE*
00052 !!
00053 !!    MODIFICATIONS
00054 !!    -------------
00055 !!
00056 !!      original                                                        06/94
00057 !!      modified by V. Masson               16/09/96 (prints if error occurs)
00058 !!
00059 !----------------------------------------------------------------------------
00060 !
00061 !*      0.    DECLARATIONS
00062 !             ------------
00063 !
00064 USE MODD_FMDECLAR
00065 
00066 IMPLICIT NONE
00067 !
00068 !*      0.1   Declarations of arguments
00069 !
00070 CHARACTER(LEN=*),          INTENT(IN) ::HFILEM ! file name
00071 CHARACTER(LEN=*),          INTENT(IN) ::HRECFM ! name of the desired article
00072 
00073 CHARACTER(LEN=*),          INTENT(IN) ::HFIPRI ! file for prints in FM
00074 
00075 INTEGER,                   INTENT(IN) ::KLENG  ! length of the data field
00076 
00077 INTEGER(KIND=8),DIMENSION(1:KLENG),INTENT(OUT)::KFIELD ! array containing 
00078                                                         ! the data field
00079 INTEGER,                   INTENT(OUT)::KGRID  ! C-grid indicator (u,v,w,T)
00080 INTEGER,                   INTENT(OUT)::KLENCH ! length of comment string
00081 
00082 CHARACTER(LEN=JPXKRK),     INTENT(OUT)::HCOMMENT ! comment string
00083 
00084 INTEGER,                   INTENT(OUT)::KRESP  ! return-code if problems occured
00085 
00086 !
00087 !*      0.2   Declarations of local variables
00088 !
00089 INTEGER::IRESP,ILENGA,IPOSEX,ITOTAL,INUMBR,J,IROW,IFMFNL,ILUPRI
00090 INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::IWORK,IWORKNEW
00091 INTEGER,DIMENSION(1:JPXKRK)::ICOMMENT
00092 CHARACTER(LEN=JPFINL)::YFNLFI
00093 CHARACTER(LEN=LEN(HFILEM))::YINTFN
00094 INTEGER :: DATASIZE,ITYPCOD,NEWSIZE
00095 !
00096 !*      0.3   Taskcommon for logical units
00097 !
00098 COMMON/TASKREAD/ILUPRI,INUMBR,IRESP
00099 !DIR$ TASKCOMMON TASKREAD
00100 !
00101 !----------------------------------------------------------------------------
00102 !
00103 !*      1.1   THE NAME OF LFIFM
00104 !
00105 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00106 IF (LHOOK) CALL DR_HOOK('FM_READ',0,ZHOOK_HANDLE)
00107 IRESP = 0 ; IROW = 0 ; ILUPRI = 6
00108 IFMFNL=JPFINL-4
00109 
00110 IROW=LEN(HFILEM)
00111 
00112 IF (IROW.EQ.0) THEN
00113    IRESP=-61
00114    GOTO 1000
00115 ELSEIF (IROW.GT.IFMFNL) THEN
00116    IRESP=-62
00117    GOTO 1000
00118 ENDIF
00119 YINTFN=ADJUSTR(HFILEM)
00120 YFNLFI=YINTFN//'.lfi'
00121 YFNLFI=ADJUSTL(YFNLFI)
00122 
00123 !
00124 !*      1.2   WE LOOK FOR THE FILE'S LOGICAL UNIT
00125 !
00126 CALL FMLOOK(YFNLFI,HFIPRI,INUMBR,IRESP)
00127 IF (IRESP.NE.0) GOTO 1000
00128 
00129 !
00130 !*      2.a   LET'S GET SOME INFORMATION ON THE DESIRED ARTICLE
00131 !
00132 !ILENGA=0
00133 !print *,' ***FM_READ ILENGA mis a 0 avant CALL LFINFO'
00134 CALL LFINFO(IRESP,INUMBR,HRECFM,ILENGA,IPOSEX)
00135 !print *,' ***FM_READ ILENGA,IRESP AP LFINFO ',ILENGA,IRESP
00136 IF (IRESP.NE.0) THEN
00137         GOTO 1000
00138 ELSEIF (ILENGA.EQ.0) THEN
00139 !print *,' ***FM_READ passage IRESP=-47 GOTO 1000'
00140         IRESP=-47
00141         GOTO 1000
00142 ELSEIF (ILENGA.GT.JPXFIE) THEN
00143         IRESP=-48
00144         GOTO 1000
00145 ENDIF
00146 
00147 !
00148 !*      2.b   UNFORMATTED DIRECT ACCESS READ OPERATION
00149 !
00150 ITOTAL=ILENGA
00151 IF(ALLOCATED(IWORK)) DEALLOCATE(IWORK)
00152 ALLOCATE(IWORK(ITOTAL))
00153 
00154 CALL LFILEC(IRESP,INUMBR,HRECFM,IWORK,ITOTAL)
00155 IF (IRESP.NE.0) GOTO 1000
00156 !
00157 !*      2.c   THE GRID INDICATOR AND THE COMMENT STRING
00158 !*            ARE SEPARATED FROM THE DATA
00159 !
00160 KGRID=IWORK(1)
00161 KLENCH=IWORK(2)
00162 IF (KLENCH < 0 .OR. KLENCH > JPXKRK) THEN
00163   IRESP=-58
00164   GOTO 1000
00165 END IF
00166 !
00167 DATASIZE=ITOTAL-KLENCH-2
00168 !
00169 !pas de compression
00170 !
00171 !CALL GET_COMPHEADER(IWORK(3+KLENCH),DATASIZE,NEWSIZE,ITYPCOD)
00172 !IF (NEWSIZE >= 0) THEN
00173   !! compressed field found
00174   !WRITE (ILUPRI,*) TRIM(HRECFM),' is compressed (old/new/kleng SIZE):',DATASIZE,NEWSIZE,KLENG 
00175   !IF (KLENG /= NEWSIZE) THEN
00176     !IRESP=-63
00177     !GOTO 1000
00178   !ENDIF
00179 !
00180   !ALLOCATE(IWORKNEW(NEWSIZE))
00181   !CALL DECOMPRESS_FIELD(IWORKNEW,NEWSIZE,IWORK(3+KLENCH),DATASIZE,ITYPCOD)
00182   !KFIELD(1:KLENG) = IWORKNEW(1:KLENG)
00183   !DEALLOCATE(IWORKNEW)
00184 !ELSE
00185   IF (KLENG > DATASIZE) THEN
00186     IRESP=-63
00187     GOTO 1000
00188   END IF
00189   KFIELD(1:KLENG)=IWORK(KLENCH+3:KLENCH+2+KLENG)
00190 !END IF
00191 !
00192 SELECT CASE (KLENCH)
00193 CASE(-10:-1)
00194        IRESP=-58
00195        GOTO 1000
00196 CASE(0)
00197        KFIELD(1:KLENG)=IWORK(3:ITOTAL)
00198 CASE(1:JPXKRK)
00199        ICOMMENT(1:KLENCH)=IWORK(3:KLENCH+2)
00200        DO J=1,KLENCH
00201           HCOMMENT(J:J)=CHAR(ICOMMENT(J))
00202        ENDDO
00203 CASE(JPXKRK+1:)
00204        IRESP=-56
00205        GOTO 1000
00206 END SELECT
00207 !
00208 DEALLOCATE(IWORK)
00209 !
00210 !  this is a pure binary field: no uncompressing of any kind
00211 !
00212 !*      3.    MESSAGE PRINTING WHATEVER THE ISSUE WAS
00213 !
00214 1000    CONTINUE
00215 
00216 IF (IRESP.NE.0) THEN
00217   YFNLFI=ADJUSTL(HFIPRI)
00218   DO J=1,JPNXLU
00219     IF (CNAMFI(J).EQ.YFNLFI) THEN
00220       ILUPRI=J
00221       EXIT
00222     ENDIF
00223   ENDDO
00224   WRITE (ILUPRI,*) ' exit from FMREAD with IRESP:',IRESP
00225   !WRITE (ILUPRI,*) '   | HFILEM = ',HFILEM
00226   WRITE (ILUPRI,*) '   | HRECFM = ',HRECFM
00227   !WRITE (ILUPRI,*) '   | KLENG  = ',KLENG
00228   !WRITE (ILUPRI,*) '   | KGRID  = ',KGRID
00229   !WRITE (ILUPRI,*) '   | KLENCH  = ',KLENCH
00230   ! Suppression OBLIGATOIRE de l'impression suivante car pb qd IWORK non alloue
00231   ! (IRESP=-47)
00232   !WRITE (ILUPRI,*) '   | KLENCH  = ',IWORK(23)
00233 ENDIF
00234 KRESP=IRESP
00235 
00236 IF(ALLOCATED(IWORK)) DEALLOCATE(IWORK)
00237 
00238 IF (LHOOK) CALL DR_HOOK('FM_READ',1,ZHOOK_HANDLE)
00239 
00240       END SUBROUTINE FM_READ