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

Go to the documentation of this file.
00001 !     #######################
00002       SUBROUTINE READ_SURF_ISBA_PAR_n(HPROGRAM,HREC,KLUOUT,KSIZE,PFIELD,KRESP,KVERSION,HCOMMENT,HDIR)
00003 !     #######################
00004 !
00005 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
00006 USE MODD_ISBA_n, ONLY : NPATCH
00007 !
00008 USE MODI_READ_SURF
00009 USE MODI_HOR_INTERPOL
00010 USE MODI_PUT_ON_ALL_VEGTYPES
00011 USE MODI_VEGTYPE_TO_PATCH
00012 !
00013 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00014 USE PARKIND1  ,ONLY : JPRB
00015 !
00016 IMPLICIT NONE
00017 !
00018  CHARACTER(LEN=6),        INTENT(IN) :: HPROGRAM ! calling program
00019  CHARACTER(LEN=*),        INTENT(IN) :: HREC   ! name of the article to be read
00020 !
00021 INTEGER,                 INTENT(IN) :: KLUOUT
00022 INTEGER,                 INTENT(IN) :: KSIZE
00023 REAL, DIMENSION(:,:),    INTENT(OUT):: PFIELD ! array containing the data field  
00024 
00025 INTEGER                  ,INTENT(OUT) :: KRESP      ! KRESP  : return-code if a problem appears
00026 INTEGER, INTENT(IN) :: KVERSION
00027  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: HCOMMENT   ! name of the article to be read
00028  CHARACTER(LEN=1),OPTIONAL,INTENT(IN)  :: HDIR       ! type of field :
00029 !                                                   ! 'H' : field with
00030 !                                                   !       horizontal spatial dim.
00031 !                                                   ! '-' : no horizontal dim.
00032 !
00033 !* local variables
00034 !  ---------------
00035 !
00036 REAL, DIMENSION(KSIZE, NVEGTYPE)  :: ZFIELD
00037 REAL, DIMENSION(SIZE(PFIELD,1),1,NPATCH) :: ZFIELD_PATCH
00038 REAL, DIMENSION(SIZE(PFIELD,1),1,NVEGTYPE) :: ZFIELD_VEGTYPE
00039  CHARACTER(LEN=1)   :: YDIR
00040 INTEGER :: INI, JPATCH, IPATCH, JVEGTYPE
00041 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00042 !
00043 !-------------------------------------------------------------------
00044 IF (LHOOK) CALL DR_HOOK('READ_SURF_ISBA_PAR_n',0,ZHOOK_HANDLE)
00045 !
00046 YDIR = 'H'
00047 IF (PRESENT(HDIR)) YDIR = HDIR
00048 !
00049 INI = SIZE(PFIELD,1)
00050 !
00051 IF (KVERSION<7) THEN
00052   CALL READ_SURF(HPROGRAM,HREC,ZFIELD(:,1:NPATCH),KRESP,HCOMMENT=HCOMMENT,HDIR=YDIR)
00053   IF (INI.NE.KSIZE) THEN
00054     CALL HOR_INTERPOL(KLUOUT,ZFIELD(:,1:NPATCH),PFIELD(:,1:NPATCH))
00055   ELSE
00056     PFIELD(:,1:NPATCH) = ZFIELD(:,1:NPATCH)
00057   ENDIF
00058   DO JPATCH = 1, NPATCH
00059     ZFIELD_PATCH(:,1,JPATCH) = PFIELD(:,JPATCH)
00060   ENDDO
00061   CALL PUT_ON_ALL_VEGTYPES(INI,1,NPATCH,NVEGTYPE,ZFIELD_PATCH,ZFIELD_VEGTYPE)
00062   PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
00063 ELSE
00064   CALL READ_SURF(HPROGRAM,HREC,ZFIELD(:,:),KRESP,HCOMMENT=HCOMMENT,HDIR=YDIR)
00065   IF (INI.NE.KSIZE) THEN
00066     CALL HOR_INTERPOL(KLUOUT,ZFIELD(:,:),ZFIELD_VEGTYPE(:,1,:))
00067   ELSE
00068     ZFIELD_VEGTYPE(:,1,:) = ZFIELD(:,:)
00069   ENDIF  
00070   IF (SIZE(PFIELD,2).NE.NVEGTYPE) THEN
00071     IPATCH = SIZE(PFIELD,2)
00072     PFIELD(:,:) = 0.
00073     DO JVEGTYPE = 1, NVEGTYPE
00074       JPATCH = VEGTYPE_TO_PATCH(JVEGTYPE,IPATCH)
00075       IF (JPATCH<=IPATCH) PFIELD(:,JPATCH) = MAX(PFIELD(:,JPATCH),ZFIELD_VEGTYPE(:,1,JVEGTYPE))
00076     ENDDO
00077   ELSE
00078     PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
00079   ENDIF        
00080 ENDIF
00081 !
00082 IF (LHOOK) CALL DR_HOOK('READ_SURF_ISBA_PAR_n',1,ZHOOK_HANDLE)
00083 !-------------------------------------------------------------------
00084 !
00085 END SUBROUTINE READ_SURF_ISBA_PAR_n