read_covers_param.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     ############################
      SUBROUTINE read_covers_param(KFILE)
!     ############################
!
!!**** *READ_COVERS_PARAM* initializes cover-field correspondance arrays
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    S.Faroux        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    23/03/11
!!
!!    R. Alkama    05/2012 : read 19 vegtypes rather than 12
!     10/2014 : add status='old' for ecoclimap.bin files E. Martin
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------

USE modd_type_date_surf
!
USE modd_data_cover,     ONLY : xdata_town, xdata_nature, xdata_sea, xdata_water,   &
                                  xdata_vegtype, xdata_lai, xdata_h_tree,           &
                                  xdata_root_depth, xdata_ground_depth, xdata_dice, &
                                  xdata_lai_all_years, tdata_seed, tdata_reap,      &
                                  xdata_alb_soil_nir, xdata_alb_soil_vis,           &
                                  xdata_alb_veg_nir, xdata_alb_veg_vis,             &                                  
                                  xdata_watsup, xdata_irrig,                        &
                                  xdata_z0_town, xdata_bld_height, xdata_wall_o_hor,&
                                  xdata_bld, xdata_garden,                          &
                                  xdata_alb_roof, xdata_alb_road, xdata_alb_wall,   &
                                  xdata_emis_roof, xdata_emis_road, xdata_emis_wall,&
                                  xdata_hc_roof, xdata_hc_road, xdata_hc_wall,      &
                                  xdata_tc_roof, xdata_tc_road, xdata_tc_wall,      &
                                  xdata_d_roof, xdata_d_road, xdata_d_wall,         &
                                  xdata_h_traffic, xdata_le_traffic,                &
                                  xdata_h_industry, xdata_le_industry,              &
                                  neco2_start_year, neco2_end_year
!
USE modd_data_cover_par, ONLY : nvegtype, jpcover, ncover_eco1_end, ncover_eco2_start
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
INTEGER, INTENT(IN)   :: KFILE
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER               :: IERR_OPEN
INTEGER               :: INB_COVER, INB_AN
INTEGER               :: ICOVER, IREC
INTEGER               :: JCOVER
!
!*    0.3    Declaration of namelists
!            ------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('READ_COVERS_PARAM',0,zhook_handle)
!
!opening of the file
IF (kfile==1) THEN
  OPEN(41,file='ecoclimapI_covers_param.bin',form='UNFORMATTED',access='DIRECT', &
          recl=20*8,status='OLD',iostat=ierr_open)  
  IF (ierr_open /= 0 ) THEN
          CALL abor1_sfx ('ERROR WHILE OPENING ''ecoclimapI_covers_param.bin'' THIS FILE IS NEEDED AND MUST BE'// &
                  ' IN (OR LINKED TO) THE RUN DIRECTORY')
  ENDIF        
  inb_cover = ncover_eco1_end
  inb_an = 1
ELSEIF (kfile==2) THEN
  OPEN(41,file='ecoclimapII_eu_covers_param.bin',form='UNFORMATTED',access='DIRECT',  &
          recl=20*8,status='OLD',iostat=ierr_open)
  IF (ierr_open /= 0 ) THEN
          CALL abor1_sfx ('ERROR WHILE OPENING ''ecoclimapII_eu_covers_param.bin'' THIS FILE IS NEEDED AND MUST BE'// &
                  ' IN (OR LINKED TO) THE RUN DIRECTORY')
  ENDIF
  inb_cover = jpcover - ncover_eco2_start + 1
  inb_an = neco2_end_year - neco2_start_year + 1
ENDIF
!
irec=0
DO jcover = 1,inb_cover
  irec = irec+1
  READ(41,rec=irec) icover
  !fractions of tiles
  irec=irec+1
  READ(41,rec=irec) xdata_town(icover),xdata_nature(icover),xdata_water(icover),xdata_sea(icover)
  !natural part
  IF (xdata_nature(icover).NE.0.) CALL read_nature
  !urban part
  IF (xdata_town(icover).NE.0.) THEN
    !main town parameters
    irec=irec+1
    READ(41,rec=irec) xdata_z0_town(icover),xdata_bld_height(icover),xdata_wall_o_hor(icover),&
        xdata_bld(icover),xdata_garden(icover)
    !town albedos
    irec=irec+1
    READ(41,rec=irec) xdata_alb_roof(icover),xdata_alb_road(icover),xdata_alb_wall(icover)
    !town emissivities
    irec=irec+1
    READ(41,rec=irec) xdata_emis_roof(icover),xdata_emis_road(icover),xdata_emis_wall(icover)
    !town heat capacity
    irec=irec+1
    READ(41,rec=irec) xdata_hc_roof(icover,:)
    irec=irec+1
    READ(41,rec=irec) xdata_hc_road(icover,:)
    irec=irec+1
    READ(41,rec=irec) xdata_hc_wall(icover,:)
    !town thermal conductivity
    irec=irec+1
    READ(41,rec=irec) xdata_tc_roof(icover,:)
    irec=irec+1
    READ(41,rec=irec) xdata_tc_road(icover,:)
    irec=irec+1
    READ(41,rec=irec) xdata_tc_wall(icover,:)
    !town depths
    irec=irec+1
    READ(41,rec=irec) xdata_d_roof(icover,:)
    irec=irec+1
    READ(41,rec=irec) xdata_d_road(icover,:)
    irec=irec+1
    READ(41,rec=irec) xdata_d_wall(icover,:)
    !traffic and industry fluxes
    irec=irec+1
    READ(41,rec=irec) xdata_h_traffic(icover),xdata_le_traffic(icover),xdata_h_industry(icover),xdata_le_industry(icover)
    IF (xdata_garden(icover).NE.0. .AND. xdata_nature(icover).EQ.0.) CALL read_nature
  ENDIF
ENDDO
CLOSE(41)
!
IF (lhook) CALL dr_hook('READ_COVERS_PARAM',1,zhook_handle)
!------------------------------------------------------------------------------
CONTAINS
!
SUBROUTINE read_nature
!
REAL, DIMENSION(12) :: ZINTER
INTEGER               :: JVEGTYPE, JLAI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('READ_COVERS_PARAM:READ_NATURE',0,zhook_handle)
!
!fractions of vegtypes
irec=irec+1
READ(41,rec=irec) xdata_vegtype(icover,:)
!
!albedos for the soil
IF (kfile<=2 .AND. xdata_nature(icover)/=0.) THEN
  irec=irec+1
  READ(41,rec=irec) zinter(:)
  xdata_alb_soil_nir(icover,1:12,1) = zinter(:)
  irec=irec+1
  READ(41,rec=irec) zinter(:)
  xdata_alb_soil_nir(icover,13:24,1) = zinter(:)
  irec=irec+1
  READ(41,rec=irec) zinter(:) 
  xdata_alb_soil_nir(icover,25:36,1) = zinter(:)
  irec=irec+1
  READ(41,rec=irec) zinter(:)
  xdata_alb_soil_vis(icover,1:12,1) = zinter(:)
  irec=irec+1
  READ(41,rec=irec) zinter(:) 
  xdata_alb_soil_vis(icover,13:24,1) = zinter(:)
  irec=irec+1
  READ(41,rec=irec) zinter(:) 
  xdata_alb_soil_vis(icover,25:36,1) = zinter(:)
ENDIF
!
DO jvegtype=1,nvegtype
  !not null fraction of vegtype
  IF (xdata_vegtype(icover,jvegtype).NE.0.) THEN
    !root and soil depths
    irec=irec+1      
    READ(41,rec=irec) xdata_root_depth(icover,jvegtype), xdata_ground_depth(icover,jvegtype), xdata_dice(icover,jvegtype)
    IF (jvegtype.GT.3) THEN
      !LAI
      DO jlai=1,inb_an*3
        irec=irec+1
        IF (kfile==1) THEN
          READ(41,rec=irec) zinter(:)
          xdata_lai(icover,(jlai-1)*12+1:jlai*12,jvegtype) = zinter(:)
        ELSEIF (kfile==2) THEN
          READ(41,rec=irec) zinter(:)
          xdata_lai_all_years(icover,(jlai-1)*12+1:jlai*12,jvegtype) = zinter(:)
        ENDIF
      ENDDO
      !Heights of trees
      IF ((jvegtype < 7) .OR. (jvegtype > 12 .AND. jvegtype /= 18)) THEN
        irec=irec+1
        READ(41,rec=irec) xdata_h_tree(icover,jvegtype)
      ENDIF
      !albedos for the vegetation
      IF (kfile<=2 .AND. xdata_nature(icover)/=0.) THEN
        irec=irec+1
        READ(41,rec=irec) zinter(:) 
        xdata_alb_veg_nir(icover,1:12,jvegtype) = zinter(:)
        irec=irec+1
        READ(41,rec=irec) zinter(:) 
        xdata_alb_veg_nir(icover,13:24,jvegtype) = zinter(:)
        irec=irec+1
        READ(41,rec=irec) zinter(:) 
        xdata_alb_veg_nir(icover,25:36,jvegtype) = zinter(:)
        irec=irec+1
        READ(41,rec=irec) zinter(:) 
        xdata_alb_veg_vis(icover,1:12,jvegtype) = zinter(:)
        irec=irec+1
        READ(41,rec=irec) zinter(:) 
        xdata_alb_veg_vis(icover,13:24,jvegtype) = zinter(:)
        irec=irec+1
        READ(41,rec=irec) zinter(:) 
        xdata_alb_veg_vis(icover,25:36,jvegtype) = zinter(:)
      ENDIF
    ELSE
      !LAI for bare areas
      IF (kfile==1) THEN
        xdata_lai(icover,:,jvegtype) = 0.
      ELSEIF (kfile==2) THEN
        xdata_lai_all_years(icover,:,jvegtype) = 0.
      ENDIF
      xdata_alb_veg_nir(icover,:,jvegtype) = 0.3
      xdata_alb_veg_vis(icover,:,jvegtype) = 0.1
    ENDIF
    !irrigation
    IF (jvegtype.EQ.8 .AND. kfile.EQ.1 .OR. jvegtype.EQ.9 .AND. kfile.EQ.2) THEN
      irec=irec+1
      READ(41,rec=irec) tdata_seed(icover,jvegtype)%TDATE%MONTH, tdata_seed(icover,jvegtype)%TDATE%DAY, &
        tdata_reap(icover,jvegtype)%TDATE%MONTH, tdata_reap(icover,jvegtype)%TDATE%DAY, &
        xdata_watsup(icover,jvegtype),xdata_irrig(icover,jvegtype)
    ENDIF
  ENDIF
ENDDO
!
IF (lhook) CALL dr_hook('READ_COVERS_PARAM:READ_NATURE',1,zhook_handle)
!
END SUBROUTINE read_nature
!
END SUBROUTINE read_covers_param