ConfigureExtents Subroutine

private subroutine ConfigureExtents(fileini, pathout)

Configure extents for computing and storing spatial average values

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: fileini
character(len=*), intent(in) :: pathout

Variables

Type Visibility Attributes Name Initial
integer(kind=short), public :: c
character(len=300), public :: filename
integer(kind=short), public :: i
type(IniList), public :: iniDB
character(len=300), public :: maskfile
integer(kind=short), public :: r

Source Code

SUBROUTINE ConfigureExtents   & 
!
 (fileini, pathout)  

IMPLICIT NONE

!arguments with intent in:
CHARACTER(LEN = *), INTENT(IN)    :: fileini 
CHARACTER(LEN = *), INTENT(IN)    :: pathout 

!local declarations
TYPE(IniList)          :: iniDB
INTEGER (KIND = short) :: i, r, c
CHARACTER (LEN = 300)  :: maskfile
CHARACTER (LEN = 300)  :: filename

!-------------------------------end of declaration-----------------------------

IF ( .NOT. ( meteoInitialized   .AND. &
    balanceInitialized .AND. &
    snowInitialized    .AND. &
    iceInitialized     .AND. &
    sedimentInitialized .AND. &
    canopyInitialized .AND. &
    plantsInitialized ) ) THEN
    
    !initialization still not finished 
    RETURN

END IF


CALL Catch ('info', 'SpatialAverage', 'Configuring extents ')

!  open and read configuration file
CALL IniOpen (fileini, iniDB) 


!configure extents
CALL Catch ('info', 'SpatialAverage', 'configuring extents ')
CALL TableNew (fileini, extent_table)
nextents = TableGetNrows (extent_table)
ALLOCATE (extents(nextents))

DO i = 1, nextents
   !read id
   CALL TableGetValue ( REAL(i), extent_table, 'count', 'id', extents (i) % id)
   
   !read name
   CALL TableGetValue ( REAL(i), extent_table, 'count', 'name', extents (i) % name)
   
   !read mask
   CALL TableGetValue ( REAL(i), extent_table, 'count', 'file', maskfile)
   CALL NewGrid (extents (i) % mask, maskfile, ESRI_ASCII)
   extents (i) % mask % grid_mapping = DecodeEPSG ( IniReadInt ('epsg', iniDB))

   !compute surface area
   extents (i) % area = 0.
   DO r = 1, extents (i) % mask % idim
     DO c = 1, extents (i) % mask % jdim
        IF (extents (i) % mask % mat (r,c) /= extents (i) % mask % nodata) THEN
           extents (i) % area = extents (i) % area + &
                               CellArea (extents (i) % mask, r, c)
        END IF
     END DO
   END DO
  
   IF (countmeteo > 0) THEN
      ALLOCATE ( extents (i) % meteo (countmeteo))
      filename = TRIM(pathout) // TRIM(extents (i) % name) // '_meteo.out'
      extents (i) % filemeteo = filename
   END IF
   
   IF (countbalance > 0) THEN
     ALLOCATE ( extents (i) % balance (countbalance))
     filename = TRIM(pathout) // TRIM(extents (i) % name) // '_balance.out'
     extents (i) % filebalance = filename
   END IF
   
   IF (countsnow > 0) THEN
     ALLOCATE ( extents (i) % snow (countsnow))
     filename = TRIM(pathout) // TRIM(extents (i) % name) // '_snow.out'
     extents (i) % filesnow = filename
   END IF

   IF (countice > 0) THEN
     ALLOCATE ( extents (i) % ice (countice))
     filename = TRIM(pathout) // TRIM(extents (i) % name) // '_glaciers.out'
     extents (i) % fileice = filename
   END IF
   
   IF (countsediment > 0) THEN
     ALLOCATE ( extents (i) % sediment (countsediment))
     filename = TRIM(pathout) // TRIM(extents (i) % name) // '_sediment.out'
     extents (i) % filesediment = filename
   END IF
   
   IF (countcanopy > 0) THEN
     ALLOCATE ( extents (i) % canopy (countcanopy))
     filename = TRIM(pathout) // TRIM(extents (i) % name) // '_canopy.out'
     extents (i) % filecanopy = filename
   END IF
   
   IF (countplants > 0) THEN
     ALLOCATE ( extents (i) % plants (countplants))
     filename = TRIM(pathout) // TRIM(extents (i) % name) // '_plants.out'
     extents (i) % fileplants = filename
   END IF
   
END DO

CALL IniClose (iniDB) 


RETURN
END SUBROUTINE ConfigureExtents