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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_BINLLVFAST(HPROGRAM,HSUBROUTINE,HFILENAME)
00003 !     ##############################################################
00004 !
00005 !!**** *READ_BINLLVFAST* reads a binary latlonvalue file and call treatment 
00006 !!                   subroutine : optimized version of READ_BINLLV routine.
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!
00012 !!    REFERENCE
00013 !!    ---------
00014 !!
00015 !!    AUTHOR
00016 !!    ------
00017 !!
00018 !!    D. Gazen          L.A.
00019 !!
00020 !!    MODIFICATION
00021 !!    ------------
00022 !!
00023 !!    Original    29/11/2002
00024 !!                03/2004  externalization (V. Masson)
00025 !!
00026 !----------------------------------------------------------------------------
00027 !
00028 !*    0.     DECLARATION
00029 !            -----------
00030 !
00031 USE MODD_SURF_PAR,   ONLY : XUNDEF
00032 USE MODD_PGD_GRID,   ONLY : LLATLONMASK
00033 !
00034 USE MODI_OPEN_FILE
00035 USE MODI_CLOSE_FILE
00036 USE MODI_PT_BY_PT_TREATMENT
00037 USE MODI_GET_LUOUT
00038 !
00039 !
00040 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00041 USE PARKIND1  ,ONLY : JPRB
00042 !
00043 IMPLICIT NONE
00044 !
00045 !*    0.1    Declaration of arguments
00046 !            ------------------------
00047 !
00048  CHARACTER(LEN=6),  INTENT(IN) :: HPROGRAM      ! Type of program
00049  CHARACTER(LEN=6),  INTENT(IN) :: HSUBROUTINE   ! Name of the subroutine to call
00050  CHARACTER(LEN=28), INTENT(IN) :: HFILENAME     ! Name of the field file.
00051 !
00052 !
00053 !*    0.2    Declaration of local variables
00054 !            ------------------------------
00055 !
00056 INTEGER                                :: IGLB       ! logical units
00057 INTEGER                                :: JLAT, JLON ! indexes of LLATLONMASK array
00058 INTEGER                                :: INELT      ! number of data points in file 
00059 INTEGER                                :: ICPT       ! number of data points to be computed
00060 REAL,DIMENSION(:,:),ALLOCATABLE,TARGET :: ZLLV       ! ZLLV(1,:) :: latitude of data points
00061                                                      ! ZLLV(2,:) :: longitude of data points
00062                                                      ! ZLLV(3,:) :: value of data points
00063 REAL,DIMENSION(:,:),POINTER            :: ZLLVWORK   ! point on ZLLV array 
00064 INTEGER                                :: JI         ! loop counter
00065 !
00066 INTEGER                                :: ILUOUT     ! output listing
00067 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00068 !----------------------------------------------------------------------------
00069 !
00070 !
00071 !*    1.      Open the global file
00072 !             --------------------
00073 !
00074 IF (LHOOK) CALL DR_HOOK('READ_BINLLVFAST',0,ZHOOK_HANDLE)
00075  CALL OPEN_FILE(HPROGRAM,IGLB,HFILENAME,'UNFORMATTED',HACTION='READ')
00076 !
00077  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00078 !
00079 !----------------------------------------------------------------------------
00080 !
00081 !*    3.     Reading of a data point
00082 !            -----------------------
00083 !
00084 READ(IGLB) INELT ! number of data points
00085 ALLOCATE(ZLLV(3,INELT))
00086 READ(IGLB) ZLLV
00087 !
00088 !----------------------------------------------------------------------------
00089 !
00090 !*    4.     Test if point is in the domain
00091 !            ------------------------------
00092 !
00093 ZLLV(2,:) = ZLLV(2,:)+NINT((180.-ZLLV(2,:))/360.)*360.
00094 !
00095 ICPT = 0
00096 DO JI=1,INELT
00097   JLAT = 1 + INT( ( ZLLV(1,JI)+ 90. ) * 2. )
00098   JLAT = MIN(JLAT,360)
00099   JLON = 1 + INT( ( ZLLV(2,JI)      ) * 2. )
00100   JLON = MIN(JLON,720)
00101   IF (LLATLONMASK(JLON,JLAT)) THEN
00102     ICPT = ICPT+1
00103     ZLLV(:,ICPT) = ZLLV(:,JI)
00104   END IF
00105 END DO
00106 !
00107 !-------------------------------------------------------------------------------
00108 !
00109 !*    5.     Call to the adequate subroutine (point by point treatment)
00110 !            ----------------------------------------------------------
00111 !     
00112 IF (ICPT > 0) THEN
00113   ZLLVWORK=>ZLLV(:,1:ICPT)
00114   CALL PT_BY_PT_TREATMENT(ILUOUT,ZLLVWORK(1,:),ZLLVWORK(2,:),ZLLVWORK(3,:),HSUBROUTINE)
00115 END IF
00116 !
00117 !----------------------------------------------------------------------------
00118 !
00119 !*    6.    Closing of the data file
00120 !           ------------------------
00121 !
00122  CALL CLOSE_FILE (HPROGRAM,IGLB)
00123 !
00124 !-------------------------------------------------------------------------------
00125 !
00126 DEALLOCATE(ZLLV)
00127 IF (LHOOK) CALL DR_HOOK('READ_BINLLVFAST',1,ZHOOK_HANDLE)
00128 !
00129 !-------------------------------------------------------------------------------
00130 !
00131 END SUBROUTINE READ_BINLLVFAST