ch_init_depconst.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_depconst(KCH,KLUOUT,HSV)
!!    ##################################################
!!
!!*** *CH_INIT_DEPCONST*
!!
!!    PURPOSE
!!    -------
!      Read Henry Specific constant,  Molecular Mass and Biological reactivity
!!     factor.
!!     
!!
!!**  METHOD
!!    ------
!
!!    Chemical constant will be read from
!!    the general purpose input file . 
!!
!!       chemical molecular diffusivity MASS_MOL
!!       molecular reactivity factor REA_FACT     
!!       molecular effective Henry constant HENRY_SP
!!
!!
!!    REFERENCE
!!    ---------
!!    
!!    AUTHOR
!!    ------
!!    P. Tulet    *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!    Original 16/02/01

!!    EXTERNAL
!!    --------
!!
! open the general purpose ASCII input file
USE modi_ch_open_inputb
USE modd_ch_surf
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
INTEGER,                  INTENT(IN)  :: kch      ! chemistry input namelist logical unit
INTEGER,                  INTENT(IN)  :: kluout   ! output listing channel
 CHARACTER(LEN=*), DIMENSION(:),  INTENT(IN)  :: hsv      ! name of chemical species
!
!*      0.2    declarations of local variables
!
 CHARACTER(LEN=40) :: yformat    
                          ! format for input
 CHARACTER(LEN=40) :: youtformat = '(A32,2E15.5)'
                          ! format for output
!
INTEGER :: imass          ! number of molecular diffusivity to be read
 CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: ymassmolname !species names
REAL             , DIMENSION(:), ALLOCATABLE :: zmassmolval
                          ! molecular diffusivity value
!
INTEGER :: ireact         ! number of chemical reactivity factor to be read
 CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: yreactname !species names
REAL             , DIMENSION(:), ALLOCATABLE :: zreactval 
                          ! chemical reactivity factor value
!
INTEGER :: ihenry         ! number of chemical Henry constant to be read
 CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: yhenryname !species names
 character(len=50) :: yname
REAL             , DIMENSION(:,:), ALLOCATABLE :: zhenryval
                          !chemical Henry constant value
!
INTEGER :: ji, jn, jnreal ! loop control variables
INTEGER :: inact          ! array pointer
logical :: lopened
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!*       1.    ALLOCATE FIELD
!              --------------
!
IF (lhook) CALL dr_hook('CH_INIT_DEPCONST',0,zhook_handle)
!$OMP SINGLE
IF(.NOT. ALLOCATED(xsrealmassmolval)) ALLOCATE( xsrealmassmolval(SIZE(hsv,1)) )
IF(.NOT. ALLOCATED(xsrealreactval)  ) ALLOCATE( xsrealreactval(SIZE(hsv,1)) )
IF(.NOT. ALLOCATED(xsrealhenryval)  ) ALLOCATE( xsrealhenryval(SIZE(hsv,1),2) )
!
!
!*       2.  read chemical molecular diffusivity MASS_MOL
!
! open input file
  WRITE(kluout,*) &
       "CH_INIT_CONST: reading  molar mass" 
  CALL ch_open_inputb("MASS_MOL", kch, kluout)
!
! read number of molecular diffusivity IMASS
  READ(kch, *) imass
  WRITE(kluout,*) "number of molecular diffusivity: ", imass
!
! read data input format
  READ(kch,"(A)") yformat
  WRITE(kluout,*) "input format is: ", yformat
!$OMP END SINGLE COPYPRIVATE(IMASS,YFORMAT)
!
! allocate fields
  ALLOCATE(ymassmolname(imass))
  ALLOCATE(zmassmolval(imass))
!
inquire(kch,name=yname,opened=lopened)
! read molecular diffusivity
!$OMP SINGLE
  DO ji = 1, imass
    READ(kch,yformat) ymassmolname(ji), zmassmolval(ji)
    WRITE(kluout,yformat) ymassmolname(ji), zmassmolval(ji)
  END DO
!
!
    WRITE(kluout,'(A)') '----------------------------------------------------'
    WRITE(kluout,'(A)') 'MASS_MOL'
    WRITE(kluout,'(A)') 'molecular mass (in g/mol) for molecular diffusion'
    WRITE(kluout,'(I4)') SIZE(hsv,1)
    WRITE(kluout,'(A)') youtformat
!$OMP END SINGLE COPYPRIVATE(YMASSMOLNAME,ZMASSMOLVAL)
!
  xsrealmassmolval(:) = 50. ! default molecular mass 
  DO jnreal = 1, SIZE(hsv,1)
    inact = 0
    search_loop3 : DO jn = 1, imass
      IF (hsv(jnreal) .EQ. ymassmolname(jn)) THEN
        inact = jn
        EXIT search_loop3
      END IF
    END DO search_loop3
    IF (inact .NE. 0) xsrealmassmolval(jnreal) = zmassmolval(inact)
      WRITE(kluout,youtformat) hsv(jnreal), xsrealmassmolval(jnreal)
  END DO
!
!
!-----------------------------------------------------------------------------
!
!*       3.  read molecular reactivity factor REA_FACT
!
! open input file
!$OMP SINGLE
   WRITE(kluout,*) &
       "CH_INIT_CONST: reading  reactivity factor "  
  CALL ch_open_inputb("REA_FACT", kch, kluout)
!
! read number of molecular diffusivity IREACT
  READ(kch, *) ireact
  WRITE(kluout,*) "number of reactivity factor : ", ireact
!
! read data input format
  READ(kch,"(A)") yformat
  WRITE(kluout,*) "input format is: ", yformat
!$OMP END SINGLE COPYPRIVATE(IREACT,YFORMAT)
!
! allocate fields
  ALLOCATE(yreactname(ireact))
  ALLOCATE(zreactval(ireact))
! read reactivity factor 
!$OMP SINGLE
  DO ji = 1, ireact
    READ(kch,yformat) yreactname(ji), zreactval(ji)
    WRITE(kluout,yformat) yreactname(ji), zreactval(ji)
  END DO
!
    WRITE(kluout,'(A)') '----------------------------------------------------'
    WRITE(kluout,'(A)') 'REA_FACT'
    WRITE(kluout,'(A)') 'reactivity factor'
    WRITE(kluout,'(I4)') SIZE(hsv,1)
    WRITE(kluout,'(A)') youtformat
!$OMP END SINGLE COPYPRIVATE(YREACTNAME,ZREACTVAL)
!    
  xsrealreactval(:) = 0.0 ! default (high surface resistance)
  DO jnreal = 1, SIZE(hsv,1)
    inact = 0
    search_loop4 : DO jn = 1, ireact
      IF (hsv(jnreal) .EQ. yreactname(jn)) THEN
        inact = jn
        EXIT search_loop4
      END IF
    END DO search_loop4
    IF (inact .NE. 0) xsrealreactval(jnreal) = zreactval(inact)
      WRITE(kluout,youtformat) hsv(jnreal), xsrealreactval(jnreal)
  END DO
!
!
!-----------------------------------------------------------------------------
!
!*       4.  read molecular effective  Henry constant HENRY_SP
!
! open input file
  WRITE(kluout,*) &
       "CH_INIT_CONST: reading effective Henry constant", &
       " and its temperature correction "  
!$OMP SINGLE
  CALL ch_open_inputb("HENRY_SP", kch, kluout)
!
! read number of molecular diffusivity IHENRY
  READ(kch, *) ihenry
  WRITE(kluout,*) "number of reactivity factor : ", ihenry
!
! read data input format
  READ(kch,"(A)") yformat
  WRITE(kluout,*) "input format is: ", yformat
!$OMP END SINGLE COPYPRIVATe(IHENRY,YFORMAT)  
!
! allocate fields
  ALLOCATE(yhenryname(ihenry))
  ALLOCATE(zhenryval(ihenry,2))
!
! read reactivity factor 
!$OMP SINGLE
  DO jnreal = 1, ihenry
    READ(kch,yformat) yhenryname(jnreal), zhenryval(jnreal,1),&
                             zhenryval(jnreal,2)  
    WRITE(kluout,yformat) yhenryname(jnreal), zhenryval(jnreal,1),&
                             zhenryval(jnreal,2)  
  END DO
!
  WRITE(kluout,'(A)') '----------------------------------------------------'
  WRITE(kluout,'(A)') 'HENRY_SP'
  WRITE(kluout,'(A)') 'Henrys law constants factor / exponent'
  WRITE(kluout,'(I4)') SIZE(hsv,1)
  WRITE(kluout,'(A)') youtformat
!$OMP END SINGLE COPYPRIVATE(YHENRYNAME,ZHENRYVAL)
!  
  xsrealhenryval(:,1) = 1e-8 ! no deposition; low Henry constant
  xsrealhenryval(:,2) = 0. ! 
  DO jnreal = 1, SIZE(hsv,1)
    inact = 0
    search_loop5 : DO jn = 1, ihenry
      IF (hsv(jnreal) .EQ. yhenryname(jn)) THEN
        inact = jn
        EXIT search_loop5
      END IF
    END DO search_loop5
    IF (inact .NE. 0) xsrealhenryval(jnreal,1) = zhenryval(inact,1)
    IF (inact .NE. 0) xsrealhenryval(jnreal,2) = zhenryval(inact,2)
    WRITE(kluout,youtformat) hsv(jnreal), &
                      xsrealhenryval(jnreal,1),&
                      xsrealhenryval(jnreal,2)  
  END DO
IF (lhook) CALL dr_hook('CH_INIT_DEPCONST',1,zhook_handle)
!
END SUBROUTINE ch_init_depconst