ch_init_dep_isban.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 ch_init_dep_isba_n (CHI, NCHI, NP, DTCO, KPATCH, OCOVER, PCOVER, &
                                     KCH,KLUOUT,KLU)
!!    ##################################################
!!
!!*** *CH_INIT_DEP_ISBA_n*
!!
!!    PURPOSE
!!    -------
!        The purpose of this subroutine is to calculate the surface flux
!     (emission or deposition) for the chemical (=scalar) variable
!!
!!**  METHOD
!!    ------
!!       The surface flux will be calculated using an exchange velocity
!!    and a surface mixing ratio for each species:
!!    Flux = v_exchange * ( C(first model level) )
!!    Exchange velocity and surface concentration will be read from
!!    the general purpose input file, or, 
!!    if CCH_DRY_DEP = "WES89", the Wesley method will be used
!!    to calculate the dry deposition velocities. The wesely code
!!    has been separate into four subroutines: ch_teb_depn.f90 for town area;
!!    ch_water_depn.f90 for inland water; ch_sea_depn.f90 for sea and
!!    ch_isba_depn.f90 for nature area.
!!
!!    information read from the input file:
!!       surface values SURFVALU
!!       exchange velocities EXCHGVEL (non-Wesley)
!!
!!    in addition for Wesley:
!!       chemical molecular diffusivity MASS_MOL
!!       molecular reactivity factor REA_FACT
!!       surface resistance SURF_RES
!!       molecular effective Henry constant HENRY_SP
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!    K. Suhre    *Laboratoire d'Aerologie*
!!
!!    MODIFICATIONS
!!    -------------
!!    Original 17/11/95
!!    05/08/96 (K. Suhre) restructured
!!    19/02/98 (P. Tulet) add explicit dry deposition for chemical species
!!    11/08/98 (N. Asencio) add parallel code
!!    29/03/99 (K. Suhre) add IKB = MIN(2,SIZE(PSVT,3)) 
!!                        so that this subroutine can be called by the box model
!!    16/01/01 (P. Tulet) restructured
!!    18/01/01 (P. Tulet) add patch vegetative class, town and water/sea 
!!                        for friction velocity and aerodynamical resistance 
!!    18/07/03 (P. Tulet) surface externalisation
!!    
!!
!!    EXTERNAL
!!    --------
!
!
USE modd_ch_isba_n, ONLY : ch_isba_t, ch_isba_np_t
USE modd_isba_n, ONLY : isba_np_t
USE modd_data_cover_n, ONLY : data_cover_t
!
USE modi_ch_open_inputb  ! open the general purpose ASCII input file
USE modi_convert_cover_ch_isba
!
USE modd_ch_isba,        ONLY: xrcclayso2, xrcclayo3, xrcsandso2, xrcsando3, &
                                 xrcsnowso2, xrcsnowo3, xlandrext  
USE modd_ch_surf
USE modd_surf_par,       ONLY : xundef
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(ch_isba_t), INTENT(INOUT) :: CHI
TYPE(ch_isba_np_t), INTENT(INOUT) :: NCHI
TYPE(isba_np_t), INTENT(INOUT) :: NP
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
!
INTEGER, INTENT(IN) :: KPATCH
LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
!
INTEGER,                         INTENT(IN)  :: KCH      ! chemistry input file
INTEGER,                         INTENT(IN)  :: KLUOUT   ! output listing channel
INTEGER,                         INTENT(IN)  :: KLU      ! number of points
!
!*      0.2    declarations of local variables
!
 CHARACTER(LEN=40) :: YFORMAT    
! format for input
 CHARACTER(LEN=40) :: YOUTFORMAT = '(A32,2E15.5)'
! format for output
INTEGER :: IRESIS         ! number of chemical reactivity factor to be read
 CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YRESISNAME !resistance name
REAL             , DIMENSION(:), ALLOCATABLE :: ZRESISVAL 
! chemical reactivity factor value
!
INTEGER :: JI, JNREAL, JP ! loop control variables
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!=============================================================================
!
  !
  !        1. Default values
  !        
  IF (lhook) CALL dr_hook('CH_INIT_DEP_ISBA_N',0,zhook_handle)
  xrcclayso2 = xundef
  xrcclayo3  = xundef
  xrcsandso2 = xundef
  xrcsando3  = xundef
  xrcsnowso2 = xundef
  xrcsnowo3  = xundef
  xlandrext  = xundef
  !
  !-----------------------------------------------------------------------------
  !
  !
  IF (chi%CCH_DRY_DEP == "WES89") THEN
    !
    !*       2.    Physiographic fields
    !
    DO jp = 1,kpatch
      !
      ALLOCATE(nchi%AL(jp)%XSOILRC_SO2(np%AL(jp)%NSIZE_P))
      ALLOCATE(nchi%AL(jp)%XSOILRC_O3 (np%AL(jp)%NSIZE_P))
      !
      CALL convert_cover_ch_isba(dtco, pcover, ocover, kpatch, jp, np%AL(jp), &
                               nchi%AL(jp)%XSOILRC_SO2, nchi%AL(jp)%XSOILRC_O3)
      !
      !---------------------------------------------------------------------------
      !
      !
      !*       3.    read surface resistance SURF_RES
      !
      ALLOCATE(nchi%AL(jp)%XDEP(klu,chi%SVI%NBEQ))
      !
    ENDDO
    !
    ! open input file
    WRITE(kluout,*) &
           "CH_INIT_DEP_ISBA_n: reading  reactivity factor "  
    CALL ch_open_inputb("SURF_RES", kch, kluout)
    !
    ! read number of input surface resistance IRESIS
    READ(kch, *) iresis
    WRITE(kluout,*) "number of reactivity factor : ", iresis
    !
    ! read data input format
    READ(kch,"(A)") yformat
    WRITE(kluout,*) "input format is: ", yformat
    !
    ! allocate fields
    ALLOCATE(yresisname(iresis))
    ALLOCATE(zresisval(iresis))
    !
    ! read reactivity factor 
    DO ji = 1, iresis
      READ(kch,yformat) yresisname(ji), zresisval(ji)
      WRITE(kluout,yformat) yresisname(ji), zresisval(ji)
    END DO
!
    ! close file
    DO jnreal = 1, iresis
      IF ('LANDREXT'== yresisname(jnreal) (1:8)) xlandrext = zresisval(jnreal) 
      IF ('RCSANDSO2'== yresisname(jnreal) (1:9)) xrcsandso2 = zresisval(jnreal)
      IF ('RCSANDO3'== yresisname(jnreal) (1:8)) xrcsando3  = zresisval(jnreal) 
      IF ('RCCLAYSO2'== yresisname(jnreal) (1:9)) xrcclayso2 = zresisval(jnreal)
      IF ('RCCLAYO3'== yresisname(jnreal) (1:8)) xrcclayo3  = zresisval(jnreal) 
      IF ('RCSNOWSO2'== yresisname(jnreal) (1:9)) xrcsnowso2 = zresisval(jnreal)
      IF ('RCSNOWO3'== yresisname(jnreal) (1:8)) xrcsnowo3  = zresisval(jnreal) 
    END DO
    !
      WRITE(kluout,'(A)') '----------------------------------------------------'
      WRITE(kluout,'(A)') 'SURF_RES'
      WRITE(kluout,'(A)') 'surface resistances (s/m)'
      WRITE(kluout,'(I4)') 7
      WRITE(kluout,'(A)') youtformat
      WRITE(kluout,youtformat) 'LANDREXT',   xlandrext 
      WRITE(kluout,youtformat) 'RCSANDSO2',  xrcsandso2 
      WRITE(kluout,youtformat) 'RCSANDO3',   xrcsando3  
      WRITE(kluout,youtformat) 'RCCLAYSO2',  xrcclayso2 
      WRITE(kluout,youtformat) 'RCCLAYO3',   xrcclayo3  
      WRITE(kluout,youtformat) 'RCSNOWSO2',  xrcsnowso2 
      WRITE(kluout,youtformat) 'RCSNOWO3',   xrcsnowo3  
    !
   DEALLOCATE(yresisname)
   DEALLOCATE(zresisval)
  ELSE
    DO jp = 1,kpatch
      ALLOCATE(nchi%AL(jp)%XDEP(0,0))
    ENDDO
  END IF
IF (lhook) CALL dr_hook('CH_INIT_DEP_ISBA_N',1,zhook_handle)
  !
  !=============================================================================
  !
END SUBROUTINE ch_init_dep_isba_n