!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- !--------------- special set of characters for RCS information !----------------------------------------------------------------- ! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ground_paramn.f90,v $ $Revision: 1.3.2.2.2.2.2.2.2.2.2.3 $ ! MASDEV4_7 soil 2006/10/27 16:02:47 !----------------------------------------------------------------- ! ########## MODULE MODI_GROUND_PARAM_n ! ########## ! INTERFACE ! SUBROUTINE GROUND_PARAM_n( PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, & PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD ) ! !* surface fluxes ! -------------- ! REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s) REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg) REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg) ! flux of chemical var. (ppp.m/s) REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg) REAL, DIMENSION(:,:), INTENT(OUT) :: PSFU ! surface fluxes of horizontal REAL, DIMENSION(:,:), INTENT(OUT) :: PSFV ! momentum in x and y directions (m2/s2) ! !* Radiative parameters ! -------------------- ! REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-) REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-) REAL, DIMENSION(:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-) REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K) ! END SUBROUTINE GROUND_PARAM_n ! END INTERFACE ! END MODULE MODI_GROUND_PARAM_n ! ! ###################################################################### SUBROUTINE GROUND_PARAM_n( PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, & PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD ) ! ####################################################################### ! ! !!**** *GROUND_PARAM* !! !! PURPOSE !! ------- ! Monitor to call the externalized surface ! !!** METHOD !! ------ ! !! EXTERNAL !! -------- !! !! IMPLICIT ARGUMENTS !! ------------------ !! !! !! REFERENCE !! --------- !! !! Noilhan and Planton (1989) !! !! AUTHOR !! ------ !! S. Belair * Meteo-France * !! !! MODIFICATIONS !! ------------- !! Original 10/03/95 !! (J.Stein) 25/10/95 add the rain flux computation at the ground !! and the lbc !! (J.Stein) 15/11/95 include the strong slopes cases !! (J.Stein) 06/02/96 bug correction for the precipitation flux writing !! (J.Stein) 20/05/96 set the right IGRID value for the rain rate !! (J.Viviand) 04/02/97 add cold and convective precipitation rate !! (J.Stein) 22/06/97 use the absolute pressure !! (V.Masson) 09/07/97 add directional z0 computations and RESA correction !! (V.Masson) 13/02/98 merge the ISBA and TSZ0 routines, !! rename the routine as a monitor, called by PHYS_PARAMn !! add the town parameterization !! recomputes z0 where snow is. !! pack and unpack of 2D fields into 1D fields !! (V.Masson) 04/01/00 removes the TSZ0 case ! (F.Solmon/V.Masson) adapatation for patch approach ! modification of internal subroutine pack/ allocation in function ! of patch indices ! calling of isba for each defined patch ! averaging of patch fluxes to get nat fluxes ! (P. Tulet/G.Guenais) 04/02/01 separation of vegetatives class ! for friction velocity and ! aerodynamical resistance ! (S Donnier) 09/12/02 add specific humidity at 2m for diagnostic ! (V.Masson) 01/03/03 externalisation of the surface schemes! ! (P.Tulet ) 01/11/03 externalisation of the surface chemistry! !! (D.Gazen) 01/12/03 change emissions handling for surf. externalization !! (J.escobar) 18/10/2012 missing USE MODI_COUPLING_SURF_ATM_n & MODI_DIAG_SURF_ATM_n ! (J.escobar) 2/2014 add Forefire coupling !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD, XAVOGADRO USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF USE MODD_DYN_n, ONLY : XTSTEP USE MODD_CH_MNHC_n, ONLY : LCH_SURFACE_FLUX USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ USE MODD_DIM_n, ONLY : NKMAX USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, & XCOSSLOPE, XSINSLOPE, XZS USE MODD_REF_n, ONLY : XRHODREF USE MODD_CONF_n, ONLY : NRR USE MODD_PARAM_n, ONLY : CDCONV,CCLOUD, CRAD USE MODD_PRECIP_n, ONLY : XINPRC, XINPRR, XINPRS, XINPRG, XINPRH USE MODD_DEEP_CONVECTION_n, ONLY : XPRCONV, XPRSCONV USE MODD_CONF, ONLY : LCARTESIAN, CPROGRAM USE MODD_TIME_n, ONLY : TDTCUR USE MODD_RADIATIONS_n, ONLY : XFLALWD, XCCO2, XTSIDER, & XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, & XZENITH, XAZIM, XAER USE MODD_NSV USE MODD_GRID, ONLY : XLON0, XRPK, XBETA USE MODD_PARAM_ICE, ONLY : LSEDIC USE MODD_PARAM_C2R2, ONLY : LSEDC USE MODD_DIAG_IN_RUN USE MODD_DUST, ONLY : LDUST, CDUSTNAMES USE MODD_SALT, ONLY : LSALT, CSALTNAMES USE MODD_CH_AEROSOL USE MODD_CSTS_DUST USE MODD_CSTS_SALT ! USE MODI_NORMAL_INTERPOL USE MODI_ROTATE_WIND USE MODI_SHUMAN USE MODI_MNHGET_SURF_PARAM_n USE MODI_COUPLING_SURF_ATM_n USE MODI_DIAG_SURF_ATM_n ! USE MODE_ll USE MODD_ARGSLIST_ll, ONLY : LIST_ll #ifdef MNH_FOREFIRE !** MODULES FOR FOREFIRE **! USE MODD_FOREFIRE USE MODD_FOREFIRE_n USE MODI_COUPLING_FOREFIRE_n #endif ! USE MODD_IBM_PARAM_n USE MODD_TIME_n USE MODD_TIME USE MODI_TEMPORAL_DIST ! IMPLICIT NONE ! ! ! !* 0.1 declarations of arguments ! !* surface fluxes ! -------------- ! REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s) REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg) REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg) ! flux of chemical var. (ppp.m/s) REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg) REAL, DIMENSION(:,:), INTENT(OUT) :: PSFU ! surface fluxes of horizontal REAL, DIMENSION(:,:), INTENT(OUT) :: PSFV ! momentum in x and y directions (m2/s2) ! !* Radiative parameters ! -------------------- ! REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-) REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-) REAL, DIMENSION(:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-) REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K) ! ! !------------------------------------------------------------------------------- ! ! ! !* 0.2 declarations of local variables ! ------------------------------- ! ! !* Atmospheric variables ! --------------------- ! REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! vapor mixing ratio ! ! suffix 'A' stands for atmospheric variable at first model level ! REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF ! Forcing height REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTA ! Temperature REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRVA ! vapor mixing ratio REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZQA ! humidity (kg/m3) REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPA ! Pressure REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPS ! Pressure REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNA ! Exner function REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Exner function REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTHA ! potential temperature REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRAIN ! liquid precipitation (kg/m2/s) REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSNOW ! solid precipitation (kg/m2/s) REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTSUN ! solar time (s since midnight) ! REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZUA ! u component of the wind ! ! parallel to the orography REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZVA ! v component of the wind ! ! parallel to the orography REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZU ! zonal wind REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZV ! meridian wind REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWIND ! wind parallel to the orography REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRHOA ! air density REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZDIR ! wind direction (rad from N clockwise) REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFU ! zonal momentum flux REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFV ! meridian momentum flux REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCO2 ! CO2 concentration (kg/kg) REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZALFA ! angle between the wind ! ! and the x axis REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZU2D ! u and v component of the REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZV2D ! wind at mass point REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH ! Turbulent flux of heat REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Turbulent flux of water REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFCO2 ! Turbulent flux of CO2 REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NSV):: ZSFTS! Turbulent flux of scalar ! !* Dimensions ! ---------- ! INTEGER :: IIB ! physical boundary INTEGER :: IIE ! physical boundary INTEGER :: IJB ! physical boundary INTEGER :: IJE ! physical boundary INTEGER :: IKB ! physical boundary INTEGER :: IKE ! physical boundary INTEGER :: IKU ! vertical array sizes ! INTEGER :: JLAYER ! loop counter INTEGER :: JSV ! loop counter INTEGER :: JI,JJ,JK ! loop index ! INTEGER :: IDIM1 ! X physical dimension INTEGER :: IDIM2 ! Y physical dimension INTEGER :: IDIM1D! total physical dimension INTEGER :: IKRAD ! !* Arrays put in 1D vectors ! ------------------------ ! REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSUN ! solar time REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZREF ! forcing height REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZS ! orography REAL, DIMENSION(:), ALLOCATABLE :: ZP_U ! zonal wind REAL, DIMENSION(:), ALLOCATABLE :: ZP_V ! meridian wind REAL, DIMENSION(:), ALLOCATABLE :: ZP_QA ! air humidity (kg/m3) REAL, DIMENSION(:), ALLOCATABLE :: ZP_TA ! air temperature REAL, DIMENSION(:), ALLOCATABLE :: ZP_RHOA ! air density REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration REAL, DIMENSION(:), ALLOCATABLE :: ZP_RAIN ! liquid precipitation REAL, DIMENSION(:), ALLOCATABLE :: ZP_SNOW ! solid precipitation REAL, DIMENSION(:), ALLOCATABLE :: ZP_LW ! incoming longwave REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_SW ! direct incoming shortwave REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_SW ! diffuse incoming shortwave REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure REAL, DIMENSION(:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! water vapor flux REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! potential temperature flux REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SFTS ! scalar flux REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFCO2 ! CO2 flux REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFU ! zonal momentum flux REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFV ! meridian momentum flux REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative surface temperature REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_ALB ! direct albedo REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_ALB ! diffuse albedo REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_A_COEF ! coefficients for REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_B_COEF ! implicit coupling REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_A_COEF REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEQ_A_COEF REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_B_COEF REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEQ_B_COEF REAL, DIMENSION(:), ALLOCATABLE :: ZP_RN ! net radiation (W/m2) REAL, DIMENSION(:), ALLOCATABLE :: ZP_H ! sensible heat flux (W/m2) REAL, DIMENSION(:), ALLOCATABLE :: ZP_LE ! latent heat flux (W/m2) REAL, DIMENSION(:), ALLOCATABLE :: ZP_GFLUX ! ground flux (W/m2) REAL, DIMENSION(:), ALLOCATABLE :: ZP_T2M ! Air temperature at 2 meters (K) REAL, DIMENSION(:), ALLOCATABLE :: ZP_Q2M ! Air humidity at 2 meters (kg/kg) REAL, DIMENSION(:), ALLOCATABLE :: ZP_HU2M ! Air relative humidity at 2 meters (-) REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZON10M ! zonal Wind at 10 meters (m/s) REAL, DIMENSION(:), ALLOCATABLE :: ZP_MER10M ! meridian Wind at 10 meters (m/s) TYPE(LIST_ll), POINTER :: TZFIELDSURF_ll ! list of fields to exchange INTEGER :: IINFO_ll ! return code of parallel routine ! REAL :: ZTIMEC ! !------------------------------------------------------------------------------- ! ! IKB= 1+JPVEXT IKU=NKMAX + 2* JPVEXT IKE=IKU-JPVEXT ! CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) ! PSFTH = XUNDEF PSFRV = XUNDEF PSFSV = XUNDEF PSFCO2 = XUNDEF PSFU = XUNDEF PSFV = XUNDEF PDIR_ALB = XUNDEF PSCA_ALB = XUNDEF PEMIS = XUNDEF PTSRAD = XUNDEF ! ! !------------------------------------------------------------------------------- ! !* 1. CONVERSION OF THE ATMOSPHERIC VARIABLES ! --------------------------------------- ! ! 1.1 water vapor ! ----------- ! ALLOCATE(ZRV(SIZE(PSFTH,1),SIZE(PSFTH,2),IKU)) ! IF(NRR>0) THEN ZRV(:,:,:)=XRT(:,:,:,1) ELSE ZRV(:,:,:)=0. END IF ! ! 1.2 Horizontal wind direction (rad from N clockwise) ! ------------------------- ! ZU2D(:,:,:)=MXF(XUT(:,:,IKB:IKB)) ZV2D(:,:,:)=MYF(XVT(:,:,IKB:IKB)) ! !* angle between Y axis and wind (rad., clockwise) ! ZALFA = 0. WHERE(ZU2D(:,:,1)/=0. .OR. ZV2D(:,:,1)/=0.) ZALFA(:,:)=ATAN2(ZU2D(:,:,1),ZV2D(:,:,1)) END WHERE WHERE(ZALFA(:,:)<0.) ZALFA(:,:) = ZALFA(:,:) + 2. * XPI ! !* angle between North and wind (rad., clockwise) ! IF (.NOT. LCARTESIAN) THEN ZDIR = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA ELSE ZDIR = - XBETA * XPI/180. + ZALFA END IF ! ! ! 1.3 Rotate the wind ! --------------- ! CALL ROTATE_WIND(XUT,XVT,XWT, & XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, & XCOSSLOPE,XSINSLOPE, & XDXX,XDYY,XDZZ, & ZUA,ZVA ) ! ! 1.4 zonal and meridian components of the wind parallel to the slope ! --------------------------------------------------------------- ! ZWIND(:,:) = SQRT( ZUA**2 + ZVA**2 ) ! ZU(:,:) = ZWIND(:,:) * SIN(ZDIR) ZV(:,:) = ZWIND(:,:) * COS(ZDIR) ! ! 1.5 Horizontal interpolation the thermodynamic fields ! ------------------------------------------------- ! CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, & XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, & XCOSSLOPE,XSINSLOPE, & XDXX,XDYY,XDZZ, & ZTHA,ZRVA,ZEXNA ) ! DEALLOCATE(ZRV) ! ! ! 1.6 Pressure and Exner function ! --------------------------- ! ! ZPA(:,:) = XP00 * ZEXNA(:,:) **(XCPD/XRD) ! ZEXNS(:,:) = 0.5 * ( (XPABST(:,:,IKB-1)/XP00)**(XRD/XCPD) & +(XPABST(:,:,IKB )/XP00)**(XRD/XCPD) & ) ZPS(:,:) = XP00 * ZEXNS(:,:) **(XCPD/XRD) ! ! 1.7 humidity in kg/m3 from the mixing ratio ! --------------------------------------- ! ! ZQA(:,:) = ZRVA(:,:) * XRHODREF(:,:,IKB) ! ! ! 1.8 Temperature from the potential temperature ! ------------------------------------------ ! ! ZTA(:,:) = ZTHA(:,:) * ZEXNA(:,:) ! ! ! 1.9 Air density ! ----------- ! ZRHOA(:,:) = ZPA(:,:)/(XRD * ZTA(:,:) * ((1. + (XRD/XRV)*ZRVA(:,:))/ & (1. + ZRVA(:,:)))) ! ! ! 1.10 Precipitations ! -------------- ! ZRAIN=0. ZSNOW=0. IF (NRR>2 .AND. SIZE(XINPRR)>0 ) THEN IF ((CCLOUD(1:3) == 'ICE' .AND. LSEDIC) .OR. & ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') .AND. LSEDC)) THEN ZRAIN = ZRAIN + XINPRR * XRHOLW + XINPRC * XRHOLW ELSE ZRAIN = ZRAIN + XINPRR * XRHOLW END IF END IF IF (CDCONV == 'KAFR') THEN ZRAIN = ZRAIN + (XPRCONV - XPRSCONV) * XRHOLW ZSNOW = ZSNOW + XPRSCONV * XRHOLW END IF IF( NRR >= 5 .AND. SIZE(XINPRS)>0 ) ZSNOW = ZSNOW + XINPRS * XRHOLW IF( NRR >= 6 .AND. SIZE(XINPRG)>0 ) ZSNOW = ZSNOW + XINPRG * XRHOLW IF( NRR >= 7 .AND. SIZE(XINPRH)>0 ) ZSNOW = ZSNOW + XINPRH * XRHOLW ! ! ! 1.11 Solar time ! ---------- ! IF (.NOT. LCARTESIAN) THEN ZTSUN(:,:) = MOD(TDTCUR%TIME -XTSIDER*3600. +XLON(:,:)*240., XDAY) ELSE ZTSUN(:,:) = MOD(TDTCUR%TIME -XTSIDER*3600. +XLON0 *240., XDAY) END IF ! ! 1.12 Forcing level ! ------------- ! ZZREF(:,:) = 0.5*( XZZ(:,:,IKB+1)-XZZ(:,:,IKB) )*XDIRCOSZW(:,:) ! ! ! 1.13 CO2 concentration (kg/m3) ! ----------------- ! ZCO2(:,:) = XCCO2 * XRHODREF(:,:,IKB) ! !------------------------------------------------------------------------------- ! !* 2. Call to surface monitor with 2D variables ! ----------------------------------------- ! ! ! initial values: ! IDIM1 = IIE-IIB+1 IDIM2 = IJE-IJB+1 IDIM1D = IDIM1*IDIM2 ! ! ! Transform 2D input fields into 1D: ! CALL RESHAPE_SURF(IDIM1D) ! ! call to have the cumulated time since beginning of simulation ! CALL TEMPORAL_DIST(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH, & TDTCUR%TDATE%DAY, TDTCUR%TIME, & TDTSEG%TDATE%YEAR,TDTSEG%TDATE%MONTH, & TDTSEG%TDATE%DAY, TDTSEG%TIME, & ZTIMEC) ! ! Call to surface schemes ! CALL COUPLING_SURF_ATM_n('MESONH', 'E',ZTIMEC, & XTSTEP, TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, TDTCUR%TDATE%DAY, TDTCUR%TIME, & IDIM1D,NSV,SIZE(XSW_BANDS), & ZP_TSUN, ZP_ZENITH,ZP_ZENITH, ZP_AZIM, & ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, CSV,& ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, ZP_PS, ZP_PA, & ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, & ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, & ZP_PEW_A_COEF, ZP_PEW_B_COEF, & ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, & 'OK' ) ! IF (CPROGRAM=='DIAG ' .OR. LDIAG_IN_RUN) THEN CALL DIAG_SURF_ATM_n('MESONH') CALL MNHGET_SURF_PARAM_n(PRN=ZP_RN,PH=ZP_H,PLE=ZP_LE,PGFLUX=ZP_GFLUX, & PT2M=ZP_T2M,PQ2M=ZP_Q2M,PHU2M=ZP_HU2M, & PZON10M=ZP_ZON10M,PMER10M=ZP_MER10M ) END IF ! ! Transform 1D output fields into 2D: ! CALL UNSHAPE_SURF(IDIM1,IDIM2) !ZSFTH(:,:)=-100. #ifdef MNH_FOREFIRE !------------------------! ! COUPLING WITH FOREFIRE ! !------------------------! IF ( LFOREFIRE ) THEN CALL FOREFIRE_DUMP_FIELDS_n(XUT, XVT, XWT, XSVT& , XTHT, XRT(:,:,:,1), XPABST, XTKET& , IDIM1+2, IDIM2+2, NKMAX+2) END IF IF ( FFCOUPLING ) THEN CALL SEND_GROUND_WIND_n(XUT, XVT, IKB, IINFO_ll) CALL FOREFIRE_RECEIVE_PARAL_n() CALL COUPLING_FOREFIRE_n(XTSTEP, ZSFTH, ZSFTQ, ZSFTS) CALL FOREFIRE_SEND_PARAL_n(IINFO_ll) END IF FF_TIME = FF_TIME + XTSTEP #endif ! ! Friction of components along slope axes (U: largest local slope axis, V: zero slope axis) ! ! PSFU(:,:) = 0. PSFV(:,:) = 0. ! WHERE (ZSFU(:,:)/=XUNDEF .AND. ZWIND(:,:)>0.) PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB) PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB) END WHERE ! !* conversion from H (W/m2) to w'Theta' ! IF (LIBM) THEN PSFTH(:,:) = XIBM_SFTH / XCPD / XRHODREF(:,:,IKB) ! imposed uniform flux (stable/neutral cases OK + testing unstable one) ELSE PSFTH(:,:) = ZSFTH / XCPD / XRHODREF(:,:,IKB) ENDIF ! ! !* conversion from water flux (kg/m2/s) to w'rv' ! PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB) ! ! !* conversion from scalar flux (kg/m2/s) to w'rsv' ! IF(NSV .GT. 0) THEN DO JSV=1,NSV PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) / XRHODREF(:,:,IKB) END DO END IF ! !* conversion from chemistry flux (molec/m2/s) to (ppp.m.s-1) ! IF (LCH_SURFACE_FLUX) THEN DO JSV=NSV_CHEMBEG,NSV_CHEMEND PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB)) END DO ELSE PSFSV(:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0. END IF ! !* conversion from dust flux (kg/m2/s) to (ppp.m.s-1) ! IF (LDUST) THEN DO JSV=NSV_DSTBEG,NSV_DSTEND PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / (XMOLARWEIGHT_DUST * XRHODREF(:,:,IKB)) END DO ELSE PSFSV(:,:,NSV_DSTBEG:NSV_DSTEND) = 0. END IF ! !* conversion from sea salt flux (kg/m2/s) to (ppp.m.s-1) ! IF (LSALT) THEN DO JSV=NSV_SLTBEG,NSV_SLTEND PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / (XMOLARWEIGHT_SALT * XRHODREF(:,:,IKB)) END DO ELSE PSFSV(:,:,NSV_SLTBEG:NSV_SLTEND) = 0. END IF ! !* conversion from aerosol flux (molec/m2/s) to (ppp.m.s-1) ! IF (LORILAM) THEN DO JSV=NSV_AERBEG,NSV_AEREND PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB)) END DO ELSE PSFSV(:,:,NSV_AERBEG:NSV_AEREND) = 0. END IF ! !* conversion from CO2 flux (kg/m2/s) to w'CO2' ! PSFCO2(:,:) = ZSFCO2(:,:) / XRHODREF(:,:,IKB) ! ! !* Diagnostics ! ----------- ! ! IF (LDIAG_IN_RUN) THEN ! XCURRENT_LW (:,:) = XFLALWD(:,:) XCURRENT_SW (:,:) = SUM(XDIRSRFSWD(:,:,:)+XSCAFLASWD(:,:,:),DIM=3) XCURRENT_SFCO2(:,:) = ZSFCO2(:,:) XCURRENT_DSTAOD(:,:)=0.0 IF (CRAD=='ECMW') THEN DO JK=IKB,IKE IKRAD = JK - 1 DO JJ=IJB,IJE DO JI=IIB,IIE XCURRENT_DSTAOD(JI,JJ)=XCURRENT_DSTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,3) ENDDO ENDDO ENDDO END IF ! NULLIFY(TZFIELDSURF_ll) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_RN ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_H ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_LE ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_GFLUX ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_SW ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_LW ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_T2M ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_Q2M ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_HU2M ) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_ZON10M) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_MER10M) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_DSTAOD) CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_SFCO2 ) CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDSURF_ll) END IF ! !================================================================================== ! CONTAINS ! !================================================================================== ! SUBROUTINE RESHAPE_SURF(KDIM1D) ! INTEGER, INTENT(IN) :: KDIM1D INTEGER, DIMENSION(1) :: ISHAPE_1 ! ISHAPE_1 = (/KDIM1D/) ! ALLOCATE(ZP_TSUN (KDIM1D)) ALLOCATE(ZP_ZENITH (KDIM1D)) ALLOCATE(ZP_AZIM (KDIM1D)) ALLOCATE(ZP_ZREF (KDIM1D)) ALLOCATE(ZP_ZS (KDIM1D)) ALLOCATE(ZP_U (KDIM1D)) ALLOCATE(ZP_V (KDIM1D)) ALLOCATE(ZP_QA (KDIM1D)) ALLOCATE(ZP_TA (KDIM1D)) ALLOCATE(ZP_RHOA (KDIM1D)) ALLOCATE(ZP_SV (KDIM1D,NSV)) ALLOCATE(ZP_CO2 (KDIM1D)) ALLOCATE(ZP_RAIN (KDIM1D)) ALLOCATE(ZP_SNOW (KDIM1D)) ALLOCATE(ZP_LW (KDIM1D)) ALLOCATE(ZP_DIR_SW (KDIM1D,SIZE(XDIRSRFSWD,3))) ALLOCATE(ZP_SCA_SW (KDIM1D,SIZE(XSCAFLASWD,3))) ALLOCATE(ZP_PS (KDIM1D)) ALLOCATE(ZP_PA (KDIM1D)) ALLOCATE(ZP_SFTQ (KDIM1D)) ALLOCATE(ZP_SFTH (KDIM1D)) ALLOCATE(ZP_SFU (KDIM1D)) ALLOCATE(ZP_SFV (KDIM1D)) ALLOCATE(ZP_SFTS (KDIM1D,NSV)) ALLOCATE(ZP_SFCO2 (KDIM1D)) ALLOCATE(ZP_TSRAD (KDIM1D)) ALLOCATE(ZP_DIR_ALB (KDIM1D,SIZE(PDIR_ALB,3))) ALLOCATE(ZP_SCA_ALB (KDIM1D,SIZE(PSCA_ALB,3))) ALLOCATE(ZP_EMIS (KDIM1D)) ALLOCATE(ZP_RN (KDIM1D)) ALLOCATE(ZP_H (KDIM1D)) ALLOCATE(ZP_LE (KDIM1D)) ALLOCATE(ZP_GFLUX (KDIM1D)) ALLOCATE(ZP_T2M (KDIM1D)) ALLOCATE(ZP_Q2M (KDIM1D)) ALLOCATE(ZP_HU2M (KDIM1D)) ALLOCATE(ZP_ZON10M (KDIM1D)) ALLOCATE(ZP_MER10M (KDIM1D)) !* explicit coupling only ALLOCATE(ZP_PEW_A_COEF (KDIM1D)) ALLOCATE(ZP_PEW_B_COEF (KDIM1D)) ALLOCATE(ZP_PET_A_COEF (KDIM1D)) ALLOCATE(ZP_PEQ_A_COEF (KDIM1D)) ALLOCATE(ZP_PET_B_COEF (KDIM1D)) ALLOCATE(ZP_PEQ_B_COEF (KDIM1D)) ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_TA(:) = RESHAPE(ZTA(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_QA(:) = RESHAPE(ZQA(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_RHOA(:) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_U(:) = RESHAPE(ZU(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_V(:) = RESHAPE(ZV(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_PS(:) = RESHAPE(ZPS(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_PA(:) = RESHAPE(ZPA(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_ZS(:) = RESHAPE(XZS(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_ZREF(:) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE), ISHAPE_1) DO JLAYER=1,NSV ZP_SV(:,JLAYER) = RESHAPE(XSVT(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1) END DO ! !chemical conversion : from part/part to molec./m3 DO JLAYER=NSV_CHEMBEG,NSV_CHEMEND ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD END DO DO JLAYER=NSV_AERBEG,NSV_AEREND ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD END DO !dust conversion : from part/part to kg/m3 DO JLAYER=NSV_DSTBEG,NSV_DSTEND ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_DUST* ZP_RHOA(:) / XMD END DO !sea salt conversion : from part/part to kg/m3 DO JLAYER=NSV_SLTBEG,NSV_SLTEND ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_SALT* ZP_RHOA(:) / XMD END DO ! ZP_ZENITH(:) = RESHAPE(XZENITH(IIB:IIE,IJB:IJE), ISHAPE_1) ZP_AZIM (:) = RESHAPE(XAZIM (IIB:IIE,IJB:IJE), ISHAPE_1) ZP_LW(:) = RESHAPE(XFLALWD(IIB:IIE,IJB:IJE), ISHAPE_1) DO JLAYER=1,SIZE(XDIRSRFSWD,3) ZP_DIR_SW(:,JLAYER) = RESHAPE(XDIRSRFSWD(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1) ZP_SCA_SW(:,JLAYER) = RESHAPE(XSCAFLASWD(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1) END DO ! ZP_PEW_A_COEF = 0. ZP_PEW_B_COEF = 0. ZP_PET_A_COEF = 0. ZP_PEQ_A_COEF = 0. ZP_PET_B_COEF = 0. ZP_PEQ_B_COEF = 0. ! END SUBROUTINE RESHAPE_SURF !================================================i================================= SUBROUTINE UNSHAPE_SURF(KDIM1,KDIM2) ! INTEGER, INTENT(IN) :: KDIM1, KDIM2 INTEGER, DIMENSION(2) :: ISHAPE_2 ! ISHAPE_2 = (/KDIM1,KDIM2/) ! ! Arguments in call to surface: ! ZSFTH = XUNDEF ZSFTQ = XUNDEF IF (NSV>0) ZSFTS = XUNDEF ZSFCO2 = XUNDEF ZSFU = XUNDEF ZSFV = XUNDEF ! ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2) ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2) DO JLAYER=1,SIZE(PSFSV,3) ZSFTS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,JLAYER), ISHAPE_2) END DO ZSFCO2 (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFCO2(:), ISHAPE_2) ZSFU (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFU(:), ISHAPE_2) ZSFV (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFV(:), ISHAPE_2) PEMIS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_EMIS(:), ISHAPE_2) PTSRAD (IIB:IIE,IJB:IJE) = RESHAPE(ZP_TSRAD(:), ISHAPE_2) ! IF (LDIAG_IN_RUN) THEN XCURRENT_RN (IIB:IIE,IJB:IJE) = RESHAPE(ZP_RN(:), ISHAPE_2) XCURRENT_H (IIB:IIE,IJB:IJE) = RESHAPE(ZP_H (:), ISHAPE_2) XCURRENT_LE (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LE(:), ISHAPE_2) XCURRENT_GFLUX (IIB:IIE,IJB:IJE) = RESHAPE(ZP_GFLUX(:), ISHAPE_2) XCURRENT_T2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_T2M(:), ISHAPE_2) XCURRENT_Q2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_Q2M(:), ISHAPE_2) XCURRENT_HU2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_HU2M(:), ISHAPE_2) XCURRENT_ZON10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZON10M(:), ISHAPE_2) XCURRENT_MER10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_MER10M(:), ISHAPE_2) ENDIF ! DO JLAYER=1,SIZE(PDIR_ALB,3) PDIR_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_DIR_ALB(:,JLAYER), ISHAPE_2) PSCA_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SCA_ALB(:,JLAYER), ISHAPE_2) END DO ! DEALLOCATE(ZP_TSUN ) DEALLOCATE(ZP_ZENITH ) DEALLOCATE(ZP_AZIM ) DEALLOCATE(ZP_ZREF ) DEALLOCATE(ZP_ZS ) DEALLOCATE(ZP_U ) DEALLOCATE(ZP_V ) DEALLOCATE(ZP_QA ) DEALLOCATE(ZP_TA ) DEALLOCATE(ZP_RHOA ) DEALLOCATE(ZP_SV ) DEALLOCATE(ZP_CO2 ) DEALLOCATE(ZP_RAIN ) DEALLOCATE(ZP_SNOW ) DEALLOCATE(ZP_LW ) DEALLOCATE(ZP_DIR_SW ) DEALLOCATE(ZP_SCA_SW ) DEALLOCATE(ZP_PS ) DEALLOCATE(ZP_PA ) DEALLOCATE(ZP_SFTQ ) DEALLOCATE(ZP_SFTH ) DEALLOCATE(ZP_SFTS ) DEALLOCATE(ZP_SFCO2 ) DEALLOCATE(ZP_SFU ) DEALLOCATE(ZP_SFV ) DEALLOCATE(ZP_TSRAD ) DEALLOCATE(ZP_DIR_ALB ) DEALLOCATE(ZP_SCA_ALB ) DEALLOCATE(ZP_EMIS ) DEALLOCATE(ZP_RN ) DEALLOCATE(ZP_H ) DEALLOCATE(ZP_LE ) DEALLOCATE(ZP_GFLUX ) DEALLOCATE(ZP_T2M ) DEALLOCATE(ZP_Q2M ) DEALLOCATE(ZP_HU2M ) DEALLOCATE(ZP_ZON10M ) DEALLOCATE(ZP_MER10M ) DEALLOCATE(ZP_PEW_A_COEF ) DEALLOCATE(ZP_PEW_B_COEF ) DEALLOCATE(ZP_PET_A_COEF ) DEALLOCATE(ZP_PEQ_A_COEF ) DEALLOCATE(ZP_PET_B_COEF ) DEALLOCATE(ZP_PEQ_B_COEF ) ! END SUBROUTINE UNSHAPE_SURF !================================================================================== ! END SUBROUTINE GROUND_PARAM_n