Juan 15/12/16 : add modi for gelato
authorGaelle DELAUTIER <gaelle.delautier@meteo.fr>
Thu, 15 Dec 2016 15:03:16 +0000 (16:03 +0100)
committerGaelle DELAUTIER <gaelle.delautier@meteo.fr>
Thu, 15 Dec 2016 15:03:16 +0000 (16:03 +0100)
bin/spll
src/SURFEX/coupling_seaflux_orogn.F90
src/SURFEX/coupling_watflux_orogn.F90
src/SURFEX/default_assim.F90
src/SURFEX/modi_glt_updasn_r.F90
src/SURFEX/vslog.F90

index d45a3c8..9d6da84 100755 (executable)
--- a/bin/spll
+++ b/bin/spll
@@ -24,7 +24,8 @@ rttov.*.F90|rttvi.F90|tstrad.*.F90|\
 ch_f77.fx90|nband_model.fx90|BASIC.f90|mode_tmat.f90|\
 ini_cmfshall.f90|mode_double_double.f90|mode_fgau.f90|\
 extern_usersurc_ll.f90|\
-extern_userio.f90|fmreadwrit.f90|fm_read_ll.f90|poub.f90"
+extern_userio.f90|fmreadwrit.f90|fm_read_ll.f90|poub.f90|\
+mode_glt.*.F90"
 #
 
 if [ "$SUF" = "f" ]
index 819abcc..5b60774 100644 (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 COUPLING_SEAFLUX_OROG_n (SM, DST, SLT, &
-                                    HPROGRAM, HCOUPLING, PTIMEC,                              &
-                 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
-                 PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,          &
-                 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
-                 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
-                 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF,                &
-                 PPEW_A_COEF, PPEW_B_COEF,                                                   &
-                 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &
-                 HTEST                                                                       )  
-!     ###############################################################################
-!
-!!****  *COUPLING_SEAFLUX_OROG_n * - Modifies the input forcing if not
-!!           initially at sea level
-!!
-!!    PURPOSE
-!!    -------
-!
-!!**  METHOD
-!!    ------
-!!
-!!    REFERENCE
-!!    ---------
-!!      
-!!
-!!    AUTHOR
-!!    ------
-!!     V. Masson 
-!!
-!!    MODIFICATIONS
-!!    -------------
-!!      Original    01/2004
-!!      B. Decharme   2008   reset the subgrid topographic effect on the forcing
-!!      J. Escobar    09/2012 SIZE(PTA) not allowed without-interface , replace by KI
-!!      B. Decharme  04/2013 new coupling variables
-!!                           improve forcing vertical shift
-!!-------------------------------------------------------------
-!
-!
-USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
-!
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_SLT_n, ONLY : SLT_t
-!
-!
-USE MODD_SURF_PAR,         ONLY : XUNDEF
-USE MODD_CSTS,             ONLY : XCPD, XRD, XP00
-!
-USE MODD_SURF_ATM, ONLY : LVERTSHIFT
-!
-USE MODI_FORCING_VERT_SHIFT
-!
-USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
-USE PARKIND1  ,ONLY : JPRB
-!
-USE MODI_COUPLING_SEAWAT_SBL_n
-!
-IMPLICIT NONE
-!
-!*      0.1    declarations of arguments
-!
-!
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-!
- CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
- CHARACTER(LEN=1),    INTENT(IN)  :: HCOUPLING ! type of coupling
-                                              ! 'E' : explicit
-                                              ! 'I' : implicit
-REAL,                INTENT(IN)  :: PTIMEC    ! current duration since start of the run (s)
-INTEGER,             INTENT(IN)  :: KYEAR     ! current year (UTC)
-INTEGER,             INTENT(IN)  :: KMONTH    ! current month (UTC)
-INTEGER,             INTENT(IN)  :: KDAY      ! current day (UTC)
-REAL,                INTENT(IN)  :: PTIME     ! current time since midnight (UTC, s)
-INTEGER,             INTENT(IN)  :: KI        ! number of points
-INTEGER,             INTENT(IN)  :: KSV       ! number of scalars
-INTEGER,             INTENT(IN)  :: KSW       ! number of short-wave spectral bands
-REAL, DIMENSION(KI), INTENT(IN)  :: PTSUN     ! solar time                    (s from midnight)
-REAL,                INTENT(IN)  :: PTSTEP    ! atmospheric time-step                 (s)
-REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! height of T,q forcing                 (m)
-REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! height of wind forcing                (m)
-!
-REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)
-REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)
-REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV     ! scalar variables
-!                                             ! chemistry:   first char. in HSV: '#'  (molecule/m3)
-!                                             !
- CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV  ! name of all scalar variables
-REAL, DIMENSION(KI), INTENT(IN)  :: PU        ! zonal wind                            (m/s)
-REAL, DIMENSION(KI), INTENT(IN)  :: PV        ! meridian wind                         (m/s)
-REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct  solar radiation (on horizontal surf.)
-!                                             !                                       (W/m2)
-REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
-!                                             !                                       (W/m2)
-REAL, DIMENSION(KSW),INTENT(IN)  :: PSW_BANDS ! mean wavelength of each shortwave band (m)
-REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH   ! zenithal angle at t  (radian from the vertical)
-REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH2  ! zenithal angle at t+1(radian from the vertical)
-REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)
-REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)
-!                                             !                                       (W/m2)
-REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)
-REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)
-REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)
-REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)
-REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)
-!
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)
-REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band  (-)
-REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS     ! emissivity                            (-)
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF    ! surface effective temperature         (K)
-REAL, DIMENSION(KI), INTENT(OUT) :: PZ0       ! roughness length for momentum         (m)
-REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H      ! roughness length for heat             (m)
-REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF    ! specific humidity at surface          (kg/kg)
-!
-REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
-REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
-REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
- CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-!*      0.2    declarations of local variables
-!
-REAL, DIMENSION(KI)  ::  ZPEQ_B_COEF   ! 1st explicit coefficient
-REAL, DIMENSION(KI)  ::  ZPET_B_COEF   ! 2nd explicit coefficient
-!
-REAL, DIMENSION(KI)  :: ZTA    ! Temperature at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZPA    ! Pressure    at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZPS    ! Pressure    at surface orography
-REAL, DIMENSION(KI)  :: ZQA    ! Humidity    at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZRHOA  ! Density     at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZLW    ! LW rad      at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZRAIN  ! Rainfall    at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZSNOW  ! Snowfall    at forcing height above surface orography
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------------
-! Preliminaries:
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',0,ZHOOK_HANDLE)
-!
-ZPEQ_B_COEF(:) = PPEQ_B_COEF(:)
-ZPET_B_COEF(:) = PPET_B_COEF(:)
-!
-IF(LVERTSHIFT)THEN
-!
-  ZTA  (:) = XUNDEF
-  ZQA  (:) = XUNDEF
-  ZPS  (:) = XUNDEF
-  ZPA  (:) = XUNDEF
-  ZRHOA(:) = XUNDEF
-  ZLW  (:) = XUNDEF
-  ZRAIN(:) = XUNDEF
-  ZSNOW(:) = XUNDEF
-!     
-   CALL FORCING_VERT_SHIFT(PZS,SM%S%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&
-                           ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW         )
-!
-   ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))
-!
-  IF (HCOUPLING=='I') THEN
-    ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA
-    ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)
-  ENDIF
-!
-ELSE
-!
-  ZTA  (:) = PTA  (:)
-  ZQA  (:) = PQA  (:)
-  ZPS  (:) = PPS  (:)
-  ZPA  (:) = PPA  (:)
-  ZRHOA(:) = PRHOA(:)
-  ZLW  (:) = PLW  (:)
-  ZRAIN(:) = PRAIN(:)
-  ZSNOW(:) = PSNOW(:)
-!
-ENDIF
-!
- CALL COUPLING_SEAFLUX_SBL_n(SM, DST, SLT, &
-                             HPROGRAM, HCOUPLING, PTIMEC, PTSTEP,                   &
-                             KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW,              &
-                             PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
-                             ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW,    &
-                             PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH,   &
-                             PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB,  &
-                             PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF,         &
-                             PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF,    &
-                             ZPEQ_B_COEF, HTEST                                     )
-!
-IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE COUPLING_SEAFLUX_OROG_n
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier\r
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence\r
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!SFX_LIC for details. version 1.\r
+!     ###############################################################################\r
+SUBROUTINE COUPLING_SEAFLUX_OROG_n (SM, DST, SLT, &\r
+                                    HPROGRAM, HCOUPLING, PTIMEC,                              &\r
+                 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &\r
+                 PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,          &\r
+                 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &\r
+                 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &\r
+                 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF,                &\r
+                 PPEW_A_COEF, PPEW_B_COEF,                                                   &\r
+                 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &\r
+                 HTEST                                                                       )  \r
+!     ###############################################################################\r
+!\r
+!!****  *COUPLING_SEAFLUX_OROG_n * - Modifies the input forcing if not\r
+!!           initially at sea level\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      \r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson \r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original    01/2004\r
+!!      B. Decharme   2008   reset the subgrid topographic effect on the forcing\r
+!!      J. Escobar    09/2012 SIZE(PTA) not allowed without-interface , replace by KI\r
+!!      B. Decharme  04/2013 new coupling variables\r
+!!                           improve forcing vertical shift\r
+!!-------------------------------------------------------------\r
+!\r
+!\r
+USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t\r
+!\r
+USE MODD_DST_n, ONLY : DST_t\r
+USE MODD_SLT_n, ONLY : SLT_t\r
+!\r
+!\r
+USE MODD_SURF_PAR,         ONLY : XUNDEF\r
+USE MODD_CSTS,             ONLY : XCPD, XRD, XP00\r
+!\r
+USE MODD_SURF_ATM, ONLY : LVERTSHIFT\r
+!\r
+USE MODI_FORCING_VERT_SHIFT\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+USE MODI_COUPLING_SEAFLUX_SBL_n\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*      0.1    declarations of arguments\r
+!\r
+!\r
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM\r
+TYPE(DST_t), INTENT(INOUT) :: DST\r
+TYPE(SLT_t), INTENT(INOUT) :: SLT\r
+!\r
+ CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes\r
+ CHARACTER(LEN=1),    INTENT(IN)  :: HCOUPLING ! type of coupling\r
+                                              ! 'E' : explicit\r
+                                              ! 'I' : implicit\r
+REAL,                INTENT(IN)  :: PTIMEC    ! current duration since start of the run (s)\r
+INTEGER,             INTENT(IN)  :: KYEAR     ! current year (UTC)\r
+INTEGER,             INTENT(IN)  :: KMONTH    ! current month (UTC)\r
+INTEGER,             INTENT(IN)  :: KDAY      ! current day (UTC)\r
+REAL,                INTENT(IN)  :: PTIME     ! current time since midnight (UTC, s)\r
+INTEGER,             INTENT(IN)  :: KI        ! number of points\r
+INTEGER,             INTENT(IN)  :: KSV       ! number of scalars\r
+INTEGER,             INTENT(IN)  :: KSW       ! number of short-wave spectral bands\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PTSUN     ! solar time                    (s from midnight)\r
+REAL,                INTENT(IN)  :: PTSTEP    ! atmospheric time-step                 (s)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! height of T,q forcing                 (m)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! height of wind forcing                (m)\r
+!\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)\r
+REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV     ! scalar variables\r
+!                                             ! chemistry:   first char. in HSV: '#'  (molecule/m3)\r
+!                                             !\r
+ CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV  ! name of all scalar variables\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PU        ! zonal wind                            (m/s)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PV        ! meridian wind                         (m/s)\r
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct  solar radiation (on horizontal surf.)\r
+!                                             !                                       (W/m2)\r
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)\r
+!                                             !                                       (W/m2)\r
+REAL, DIMENSION(KSW),INTENT(IN)  :: PSW_BANDS ! mean wavelength of each shortwave band (m)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH   ! zenithal angle at t  (radian from the vertical)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH2  ! zenithal angle at t+1(radian from the vertical)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)\r
+!                                             !                                       (W/m2)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)\r
+!\r
+!\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (m/s*kg_CO2/kg_air)\r
+REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)\r
+!\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)\r
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band  (-)\r
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS     ! emissivity                            (-)\r
+!\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF    ! surface effective temperature         (K)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PZ0       ! roughness length for momentum         (m)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H      ! roughness length for heat             (m)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF    ! specific humidity at surface          (kg/kg)\r
+!\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF\r
+ CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'\r
+!\r
+!*      0.2    declarations of local variables\r
+!\r
+REAL, DIMENSION(KI)  ::  ZPEQ_B_COEF   ! 1st explicit coefficient\r
+REAL, DIMENSION(KI)  ::  ZPET_B_COEF   ! 2nd explicit coefficient\r
+!\r
+REAL, DIMENSION(KI)  :: ZTA    ! Temperature at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZPA    ! Pressure    at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZPS    ! Pressure    at surface orography\r
+REAL, DIMENSION(KI)  :: ZQA    ! Humidity    at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZRHOA  ! Density     at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZLW    ! LW rad      at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZRAIN  ! Rainfall    at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZSNOW  ! Snowfall    at forcing height above surface orography\r
+!\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!-------------------------------------------------------------------------------------\r
+! Preliminaries:\r
+!-------------------------------------------------------------------------------------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',0,ZHOOK_HANDLE)\r
+!\r
+ZPEQ_B_COEF(:) = PPEQ_B_COEF(:)\r
+ZPET_B_COEF(:) = PPET_B_COEF(:)\r
+!\r
+IF(LVERTSHIFT)THEN\r
+!\r
+  ZTA  (:) = XUNDEF\r
+  ZQA  (:) = XUNDEF\r
+  ZPS  (:) = XUNDEF\r
+  ZPA  (:) = XUNDEF\r
+  ZRHOA(:) = XUNDEF\r
+  ZLW  (:) = XUNDEF\r
+  ZRAIN(:) = XUNDEF\r
+  ZSNOW(:) = XUNDEF\r
+!     \r
+   CALL FORCING_VERT_SHIFT(PZS,SM%S%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&\r
+                           ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW         )\r
+!\r
+   ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))\r
+!\r
+  IF (HCOUPLING=='I') THEN\r
+    ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA\r
+    ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)\r
+  ENDIF\r
+!\r
+ELSE\r
+!\r
+  ZTA  (:) = PTA  (:)\r
+  ZQA  (:) = PQA  (:)\r
+  ZPS  (:) = PPS  (:)\r
+  ZPA  (:) = PPA  (:)\r
+  ZRHOA(:) = PRHOA(:)\r
+  ZLW  (:) = PLW  (:)\r
+  ZRAIN(:) = PRAIN(:)\r
+  ZSNOW(:) = PSNOW(:)\r
+!\r
+ENDIF\r
+!\r
+ CALL COUPLING_SEAFLUX_SBL_n(SM, DST, SLT, &\r
+                             HPROGRAM, HCOUPLING, PTIMEC, PTSTEP,                   &\r
+                             KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW,              &\r
+                             PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &\r
+                             ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW,    &\r
+                             PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH,   &\r
+                             PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB,  &\r
+                             PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF,         &\r
+                             PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF,    &\r
+                             ZPEQ_B_COEF, HTEST                                     )\r
+!\r
+IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',1,ZHOOK_HANDLE)\r
+!-------------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE COUPLING_SEAFLUX_OROG_n\r
index cb71bdd..6b6fd38 100644 (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 COUPLING_WATFLUX_OROG_n (WM, DST, SLT, &
-                                    HPROGRAM, HCOUPLING, PTIMEC,                              &
-                 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
-                 PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,          &
-                 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
-                 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
-                 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF,                &
-                 PPEW_A_COEF, PPEW_B_COEF,                                                   &
-                 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &
-                 HTEST                                                                       )  
-!     ###############################################################################
-!
-!!****  *COUPLING_WATFLUX_OROG_n * - Modifies the input forcing if not
-!!           initially at lake level
-!!
-!!    PURPOSE
-!!    -------
-!
-!!**  METHOD
-!!    ------
-!!
-!!    REFERENCE
-!!    ---------
-!!      
-!!
-!!    AUTHOR
-!!    ------
-!!     V. Masson 
-!!
-!!    MODIFICATIONS
-!!    -------------
-!!      Original    01/2004
-!!      B. Decharme   2008   reset the subgrid topographic effect on the forcing
-!!      J. Escobar    09/2012  SIZE(PTA) not allowed without-interface , replace by KI
-!!      B. Decharme  04/2013 new coupling variables
-!!                           improve forcing vertical shift
-!!-------------------------------------------------------------
-!
-!
-!
-USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_SLT_n, ONLY : SLT_t
-!
-USE MODD_SURF_PAR,         ONLY : XUNDEF
-USE MODD_CSTS,             ONLY : XCPD, XRD, XP00
-!
-USE MODD_SURF_ATM, ONLY : LVERTSHIFT
-!
-USE MODI_FORCING_VERT_SHIFT
-!
-USE MODI_COUPLING_SEAWAT_SBL_n
-!
-USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
-USE PARKIND1  ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!*      0.1    declarations of arguments
-!
-!
-!
-TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-!
- CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
- CHARACTER(LEN=1),    INTENT(IN)  :: HCOUPLING ! type of coupling
-                                              ! 'E' : explicit
-                                              ! 'I' : implicit
-REAL,                INTENT(IN)  :: PTIMEC    ! cumulated time since beginning of simulation
-INTEGER,             INTENT(IN)  :: KYEAR     ! current year (UTC)
-INTEGER,             INTENT(IN)  :: KMONTH    ! current month (UTC)
-INTEGER,             INTENT(IN)  :: KDAY      ! current day (UTC)
-REAL,                INTENT(IN)  :: PTIME     ! current time since midnight (UTC, s)
-INTEGER,             INTENT(IN)  :: KI        ! number of points
-INTEGER,             INTENT(IN)  :: KSV       ! number of scalars
-INTEGER,             INTENT(IN)  :: KSW       ! number of short-wave spectral bands
-REAL, DIMENSION(KI), INTENT(IN)  :: PTSUN     ! solar time                    (s from midnight)
-REAL,                INTENT(IN)  :: PTSTEP    ! atmospheric time-step                 (s)
-REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! height of T,q forcing                 (m)
-REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! height of wind forcing                (m)
-!
-REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)
-REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)
-REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV     ! scalar variables
-!                                             ! chemistry:   first char. in HSV: '#'  (molecule/m3)
-!                                             !
- CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV  ! name of all scalar variables
-REAL, DIMENSION(KI), INTENT(IN)  :: PU        ! zonal wind                            (m/s)
-REAL, DIMENSION(KI), INTENT(IN)  :: PV        ! meridian wind                         (m/s)
-REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct  solar radiation (on horizontal surf.)
-!                                             !                                       (W/m2)
-REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
-!                                             !                                       (W/m2)
-REAL, DIMENSION(KSW),INTENT(IN)  :: PSW_BANDS ! mean wavelength of each shortwave band (m)
-REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH   ! zenithal angle at t      (radian from the vertical)
-REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH2  ! zenithal angle at t+1    (radian from the vertical)
-REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)
-REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)
-!                                             !                                       (W/m2)
-REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)
-REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)
-REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)
-REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)
-REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)
-!
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)
-REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band  (-)
-REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS     ! emissivity                            (-)
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF    ! surface effective temperature         (K)
-REAL, DIMENSION(KI), INTENT(OUT) :: PZ0       ! roughness length for momentum         (m)
-REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H      ! roughness length for heat             (m)
-REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF    ! specific humidity at surface          (kg/kg)
-!
-REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
-REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
-REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
- CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-!*      0.2    declarations of local variables
-!
-REAL, DIMENSION(KI)  ::  ZPEQ_B_COEF   ! 1st explicit coefficient
-REAL, DIMENSION(KI)  ::  ZPET_B_COEF   ! 2nd explicit coefficient
-!
-REAL, DIMENSION(KI)  :: ZTA    ! Temperature at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZPA    ! Pressure    at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZPS    ! Pressure    at surface orography
-REAL, DIMENSION(KI)  :: ZQA    ! Humidity    at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZRHOA  ! Density     at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZLW    ! LW rad      at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZRAIN  ! Rainfall    at forcing height above surface orography
-REAL, DIMENSION(KI)  :: ZSNOW  ! Snowfall    at forcing height above surface orography
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------------
-! Preliminaries:
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_OROG_N',0,ZHOOK_HANDLE)
-!
-ZPEQ_B_COEF(:) = PPEQ_B_COEF(:)
-ZPET_B_COEF(:) = PPET_B_COEF(:)
-!
-IF(LVERTSHIFT)THEN
-!
-  ZTA  (:) = XUNDEF
-  ZQA  (:) = XUNDEF
-  ZPS  (:) = XUNDEF
-  ZPA  (:) = XUNDEF
-  ZRHOA(:) = XUNDEF
-  ZLW  (:) = XUNDEF
-  ZRAIN(:) = XUNDEF
-  ZSNOW(:) = XUNDEF
-!       
-   CALL FORCING_VERT_SHIFT(PZS,WM%W%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&
-                           ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW         )
-!
-   ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))
-!
-  IF (HCOUPLING=='I') THEN
-    ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA
-    ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)
-  ENDIF
-!
-ELSE
-!
-  ZTA  (:) = PTA  (:)
-  ZQA  (:) = PQA  (:)
-  ZPS  (:) = PPS  (:)
-  ZPA  (:) = PPA  (:)
-  ZRHOA(:) = PRHOA(:)
-  ZLW  (:) = PLW  (:)
-  ZRAIN(:) = PRAIN(:)
-  ZSNOW(:) = PSNOW(:)
-!
-ENDIF
-!
- CALL COUPLING_WATFLUX_SBL_n(WM, DST, SLT, &
-                            HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME,&
-                            KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
-                            ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, PDIR_SW, PSCA_SW, &
-                            PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
-                            PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
-                            PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
-                            ZPEQ_B_COEF, HTEST                                               )
-!
-IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_OROG_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE COUPLING_WATFLUX_OROG_n
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier\r
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence\r
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!SFX_LIC for details. version 1.\r
+!     ###############################################################################\r
+SUBROUTINE COUPLING_WATFLUX_OROG_n (WM, DST, SLT, &\r
+                                    HPROGRAM, HCOUPLING, PTIMEC,                              &\r
+                 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &\r
+                 PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,          &\r
+                 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &\r
+                 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &\r
+                 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF,                &\r
+                 PPEW_A_COEF, PPEW_B_COEF,                                                   &\r
+                 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &\r
+                 HTEST                                                                       )  \r
+!     ###############################################################################\r
+!\r
+!!****  *COUPLING_WATFLUX_OROG_n * - Modifies the input forcing if not\r
+!!           initially at lake level\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      \r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson \r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original    01/2004\r
+!!      B. Decharme   2008   reset the subgrid topographic effect on the forcing\r
+!!      J. Escobar    09/2012  SIZE(PTA) not allowed without-interface , replace by KI\r
+!!      B. Decharme  04/2013 new coupling variables\r
+!!                           improve forcing vertical shift\r
+!!-------------------------------------------------------------\r
+!\r
+!\r
+!\r
+USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t\r
+USE MODD_DST_n, ONLY : DST_t\r
+USE MODD_SLT_n, ONLY : SLT_t\r
+!\r
+USE MODD_SURF_PAR,         ONLY : XUNDEF\r
+USE MODD_CSTS,             ONLY : XCPD, XRD, XP00\r
+!\r
+USE MODD_SURF_ATM, ONLY : LVERTSHIFT\r
+!\r
+USE MODI_FORCING_VERT_SHIFT\r
+!\r
+USE MODI_COUPLING_WATFLUX_SBL_n\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*      0.1    declarations of arguments\r
+!\r
+!\r
+!\r
+TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM\r
+TYPE(DST_t), INTENT(INOUT) :: DST\r
+TYPE(SLT_t), INTENT(INOUT) :: SLT\r
+!\r
+ CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes\r
+ CHARACTER(LEN=1),    INTENT(IN)  :: HCOUPLING ! type of coupling\r
+                                              ! 'E' : explicit\r
+                                              ! 'I' : implicit\r
+REAL,                INTENT(IN)  :: PTIMEC    ! cumulated time since beginning of simulation\r
+INTEGER,             INTENT(IN)  :: KYEAR     ! current year (UTC)\r
+INTEGER,             INTENT(IN)  :: KMONTH    ! current month (UTC)\r
+INTEGER,             INTENT(IN)  :: KDAY      ! current day (UTC)\r
+REAL,                INTENT(IN)  :: PTIME     ! current time since midnight (UTC, s)\r
+INTEGER,             INTENT(IN)  :: KI        ! number of points\r
+INTEGER,             INTENT(IN)  :: KSV       ! number of scalars\r
+INTEGER,             INTENT(IN)  :: KSW       ! number of short-wave spectral bands\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PTSUN     ! solar time                    (s from midnight)\r
+REAL,                INTENT(IN)  :: PTSTEP    ! atmospheric time-step                 (s)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! height of T,q forcing                 (m)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! height of wind forcing                (m)\r
+!\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)\r
+REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV     ! scalar variables\r
+!                                             ! chemistry:   first char. in HSV: '#'  (molecule/m3)\r
+!                                             !\r
+ CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV  ! name of all scalar variables\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PU        ! zonal wind                            (m/s)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PV        ! meridian wind                         (m/s)\r
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct  solar radiation (on horizontal surf.)\r
+!                                             !                                       (W/m2)\r
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)\r
+!                                             !                                       (W/m2)\r
+REAL, DIMENSION(KSW),INTENT(IN)  :: PSW_BANDS ! mean wavelength of each shortwave band (m)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH   ! zenithal angle at t      (radian from the vertical)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH2  ! zenithal angle at t+1    (radian from the vertical)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)\r
+!                                             !                                       (W/m2)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)\r
+REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)\r
+!\r
+!\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (m/s*kg_CO2/kg_air)\r
+REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)\r
+!\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)\r
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band  (-)\r
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS     ! emissivity                            (-)\r
+!\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF    ! surface effective temperature         (K)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PZ0       ! roughness length for momentum         (m)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H      ! roughness length for heat             (m)\r
+REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF    ! specific humidity at surface          (kg/kg)\r
+!\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF\r
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF\r
+ CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'\r
+!\r
+!*      0.2    declarations of local variables\r
+!\r
+REAL, DIMENSION(KI)  ::  ZPEQ_B_COEF   ! 1st explicit coefficient\r
+REAL, DIMENSION(KI)  ::  ZPET_B_COEF   ! 2nd explicit coefficient\r
+!\r
+REAL, DIMENSION(KI)  :: ZTA    ! Temperature at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZPA    ! Pressure    at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZPS    ! Pressure    at surface orography\r
+REAL, DIMENSION(KI)  :: ZQA    ! Humidity    at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZRHOA  ! Density     at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZLW    ! LW rad      at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZRAIN  ! Rainfall    at forcing height above surface orography\r
+REAL, DIMENSION(KI)  :: ZSNOW  ! Snowfall    at forcing height above surface orography\r
+!\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!-------------------------------------------------------------------------------------\r
+! Preliminaries:\r
+!-------------------------------------------------------------------------------------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_OROG_N',0,ZHOOK_HANDLE)\r
+!\r
+ZPEQ_B_COEF(:) = PPEQ_B_COEF(:)\r
+ZPET_B_COEF(:) = PPET_B_COEF(:)\r
+!\r
+IF(LVERTSHIFT)THEN\r
+!\r
+  ZTA  (:) = XUNDEF\r
+  ZQA  (:) = XUNDEF\r
+  ZPS  (:) = XUNDEF\r
+  ZPA  (:) = XUNDEF\r
+  ZRHOA(:) = XUNDEF\r
+  ZLW  (:) = XUNDEF\r
+  ZRAIN(:) = XUNDEF\r
+  ZSNOW(:) = XUNDEF\r
+!       \r
+   CALL FORCING_VERT_SHIFT(PZS,WM%W%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&\r
+                           ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW         )\r
+!\r
+   ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))\r
+!\r
+  IF (HCOUPLING=='I') THEN\r
+    ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA\r
+    ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)\r
+  ENDIF\r
+!\r
+ELSE\r
+!\r
+  ZTA  (:) = PTA  (:)\r
+  ZQA  (:) = PQA  (:)\r
+  ZPS  (:) = PPS  (:)\r
+  ZPA  (:) = PPA  (:)\r
+  ZRHOA(:) = PRHOA(:)\r
+  ZLW  (:) = PLW  (:)\r
+  ZRAIN(:) = PRAIN(:)\r
+  ZSNOW(:) = PSNOW(:)\r
+!\r
+ENDIF\r
+!\r
+ CALL COUPLING_WATFLUX_SBL_n(WM, DST, SLT, &\r
+                            HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME,&\r
+                            KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &\r
+                            ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, PDIR_SW, PSCA_SW, &\r
+                            PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &\r
+                            PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &\r
+                            PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &\r
+                            ZPEQ_B_COEF, HTEST                                               )\r
+!\r
+IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_OROG_N',1,ZHOOK_HANDLE)\r
+!\r
+!-------------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE COUPLING_WATFLUX_OROG_n\r
index c523b51..5be7cde 100644 (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 DEFAULT_ASSIM(OASSIM,HASSIM,HASSIM_ISBA,KPRINTLEV,         &
-                               OAROME,OECSST,OAESST,OAESNM,                 &
-                               OALADSURF,OREAD_SST_FROM_FILE,               &
-                               HFILE_FORMAT_SST,OEXTRAP_SEA,                &
-                               OEXTRAP_WATER,OEXTRAP_NATURE,                &
-                               OWATERTG2,KBOUTPUT,KECHGU,PRCLIMCA,          &
-                               PRCLISST,PSIGH2MO,PSIGT2MO,PSIGWGO,          &
-                               PSIGWGB,PSIGW2B,OOBSWG,OOBS2M,OIMVEG,        &
-                               PSPRECIP2,PRTHR_QC,PSIGWGO_MAX,              &
-                               PRSCAL_JAC,OPRT,OSIM,OBEV,OBFIXED,           &
-                               KOBSTYPE,OOBSHEADER,HFILE_FORMAT_OBS,OOBSNAT,&
-                               HFILE_FORMAT_FG,HFILE_FORMAT_LSM,            &
-                               HFILE_FORMAT_CLIM,PERROBS_M,PQCOBS_M,        &
-                               KNCO,KIVAR,KVAR,HVAR_M,HPREFIX_M,            &
-                               PSIGMA_M,PTPRT_M,KNCV,PSCALE_Q,              &
-                               PSCALE_QLAI,HBIO,HPREFIX_BIO,PALPH,          &
-                               KENS,KIE,PINFL_M,PADDINFL_M, PASSIM_WINH,    &
-                               PADDTIMECORR_M,OENS_GEN,OPB_CORRELATIONS,    &
-                               OPERTURBATION_RUN,OBIAS_CORRECTION,          &
-                               OENKF,ODENKF,HTEST)
-!     ########################################################################
-!
-!!****  *DEFAULT_ISBA* - routine to set default values for the configuration for ISBA assimilation scheme
-!!
-!!    PURPOSE
-!!    -------
-!!
-!!**  METHOD
-!!    ------
-!!
-!!    EXTERNAL
-!!    --------
-!!
-!!
-!!    IMPLICIT ARGUMENTS
-!!    ------------------
-!!
-!!    REFERENCE
-!!    ---------
-!!
-!!
-!!    AUTHOR
-!!    ------
-!!      L. Jarlan  *Meteo France*
-!!
-!!    MODIFICATIONS
-!!    -------------
-!!      Original    02/2005
-!-------------------------------------------------------------------------------
-!
-!*       0.    DECLARATIONS
-!              ------------
-!
-!
-USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
-USE PARKIND1  ,ONLY : JPRB
-!
-USE MODD_ASSIM, ONLY : NOBSMAX, NVARMAX
-!
-IMPLICIT NONE
-!
-!*       0.1   Declarations of arguments
-!              -------------------------
-LOGICAL,           INTENT(OUT) :: OASSIM        ! assimilation or not
- CHARACTER(LEN=5),  INTENT(OUT) :: HASSIM        ! type of corrections PLUS/2DVAR
- CHARACTER(LEN=5),  INTENT(OUT) :: HASSIM_ISBA
-INTEGER,           INTENT(OUT) :: KPRINTLEV
-LOGICAL,           INTENT(OUT) :: OAROME
-LOGICAL,           INTENT(OUT) :: OECSST
-LOGICAL,           INTENT(OUT) :: OAESST
-LOGICAL,           INTENT(OUT) :: OAESNM
-LOGICAL,           INTENT(OUT) :: OALADSURF
-LOGICAL,           INTENT(OUT) :: OREAD_SST_FROM_FILE
- CHARACTER(LEN=6),  INTENT(OUT) :: HFILE_FORMAT_SST
-LOGICAL,           INTENT(OUT) :: OEXTRAP_SEA
-LOGICAL,           INTENT(OUT) :: OEXTRAP_WATER
-LOGICAL,           INTENT(OUT) :: OEXTRAP_NATURE
-LOGICAL,           INTENT(OUT) :: OWATERTG2
-INTEGER,           INTENT(OUT) :: KBOUTPUT
-!
-INTEGER,           INTENT(OUT) :: KECHGU
-REAL,              INTENT(OUT) :: PRCLIMCA
-REAL,              INTENT(OUT) :: PRCLISST
-REAL,              INTENT(OUT) :: PSIGH2MO
-REAL,              INTENT(OUT) :: PSIGT2MO
-REAL,              INTENT(OUT) :: PSIGWGO
-REAL,              INTENT(OUT) :: PSIGWGB
-REAL,              INTENT(OUT) :: PSIGW2B
-LOGICAL,           INTENT(OUT) :: OOBSWG
-LOGICAL,           INTENT(OUT) :: OOBS2M
-LOGICAL,           INTENT(OUT) :: OIMVEG
-REAL,              INTENT(OUT) :: PSPRECIP2 
-REAL,              INTENT(OUT) :: PRTHR_QC
-REAL,              INTENT(OUT) :: PSIGWGO_MAX
-REAL,              INTENT(OUT) :: PRSCAL_JAC
-!
-LOGICAL,           INTENT(OUT) :: OPRT
-LOGICAL,           INTENT(OUT) :: OSIM
-LOGICAL,           INTENT(OUT) :: OBEV
-LOGICAL,           INTENT(OUT) :: OBFIXED
-!
-INTEGER,             INTENT(OUT) :: KOBSTYPE
-LOGICAL,             INTENT(OUT) :: OOBSHEADER
- CHARACTER(LEN=6),    INTENT(OUT) :: HFILE_FORMAT_OBS
- CHARACTER(LEN=6),    INTENT(OUT) :: HFILE_FORMAT_FG
- CHARACTER(LEN=6),    INTENT(OUT) :: HFILE_FORMAT_LSM
- CHARACTER(LEN=6),    INTENT(OUT) :: HFILE_FORMAT_CLIM
-REAL, DIMENSION(NOBSMAX),    INTENT(OUT) :: PERROBS_M
-REAL, DIMENSION(NOBSMAX),    INTENT(OUT) :: PQCOBS_M
-INTEGER, DIMENSION(NOBSMAX), INTENT(OUT) :: KNCO
-LOGICAL, INTENT(OUT) :: OOBSNAT
-!
-INTEGER,           INTENT(OUT) :: KIVAR
-INTEGER,           INTENT(OUT) :: KVAR
- CHARACTER(LEN=3),  DIMENSION(NVARMAX), INTENT(OUT) :: HVAR_M
- CHARACTER(LEN=100),  DIMENSION(NVARMAX), INTENT(OUT) :: HPREFIX_M
-REAL, DIMENSION(NVARMAX), INTENT(OUT) :: PSIGMA_M
-REAL, DIMENSION(NVARMAX), INTENT(OUT) :: PTPRT_M
-INTEGER, DIMENSION(NVARMAX), INTENT(OUT) :: KNCV
-REAL,                INTENT(OUT) :: PSCALE_Q
-REAL,                INTENT(OUT) :: PSCALE_QLAI
- CHARACTER(LEN=LEN_HREC),   INTENT(OUT) :: HBIO
- CHARACTER(LEN=100),  INTENT(OUT) :: HPREFIX_BIO
-REAL, DIMENSION(12), INTENT(OUT) :: PALPH
-!
-INTEGER, INTENT(OUT) :: KENS
-INTEGER, INTENT(OUT) :: KIE
-REAL, INTENT(OUT) :: PASSIM_WINH
-REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PINFL_M
-REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PADDINFL_M
-REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PADDTIMECORR_M
-LOGICAL, INTENT(OUT) :: OENKF
-LOGICAL, INTENT(OUT) :: ODENKF
-LOGICAL, INTENT(OUT) :: OENS_GEN
-LOGICAL, INTENT(OUT) :: OPB_CORRELATIONS
-LOGICAL, INTENT(OUT) :: OPERTURBATION_RUN
-LOGICAL, INTENT(OUT) :: OBIAS_CORRECTION
- CHARACTER(LEN=2),   INTENT(IN) :: HTEST
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('DEFAULT_ASSIM',0,ZHOOK_HANDLE)
-
-IF (HTEST/='OK') THEN
-  CALL ABOR1_SFX('default_assim: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-
-!
-OASSIM    = .FALSE.
-HASSIM    = "PLUS "
-HASSIM_ISBA = "OI" 
-KPRINTLEV = 0
-OAROME    = .TRUE.
-OECSST    = .FALSE.
-OAESST    = .FALSE.
-OAESNM    = .FALSE.
-OALADSURF = .TRUE.
-OREAD_SST_FROM_FILE=.FALSE.
-HFILE_FORMAT_SST = "FA    "
-OEXTRAP_SEA    = .TRUE.
-OEXTRAP_WATER  = .TRUE.
-OEXTRAP_NATURE = .FALSE.
-OWATERTG2      = .FALSE.
-
-KBOUTPUT = 1
-!
-KECHGU = 6
-!  RCLIMCA : coef. de rappel vers la climatologie des champs de surface
-!  RCLISST : coef. de rappel vers la climatologie de SST
-!PRCLIMCA=0.045
-PRCLIMCA = 0. ! no climatology relaxation
-!PRCLISST=0.05 ! as in the original cacsts
-PRCLISST = 0.05 
-!***  SIGT2MO : ecart-type d'erreur "d'observation" sur T2m
-!***  SIGH2MO : ecart-type d'erreur "d'observation" sur Hu2m
-PSIGH2MO = 0.1 ! observation error for HU2m
-PSIGT2MO = 1.0 ! observation error for T2m
-PSIGWGO = 0.06 ! observation error for WG
-PSIGWGB = 0.06 ! background error for WG
-PSIGW2B = 0.03 ! background error for W2
-OOBSWG = .TRUE. ! assimilation of WG
-OOBS2M = .FALSE. ! assimilation of T2M + RH2M (with WG)
-!     LIMVEG : activation de la limitation a wp > veg*wwilt
-!***  LIMVEG  : si wp >= veg*wwilt
-OIMVEG = .TRUE.
-PSPRECIP2 = 4.0
-PRTHR_QC = 3.0
-PSIGWGO_MAX = 6.0 ! maximum acceptable WG obs error (%) 
-PRSCAL_JAC = 4.0  ! to modify the "effective" assimilation window
-!
-! Initialization of EKF
-OPRT = .FALSE.
-OSIM = .FALSE.
-OBEV = .TRUE.
-OBFIXED = .FALSE.
-!
-KOBSTYPE = 2
-OOBSHEADER = .FALSE.
-HFILE_FORMAT_OBS = "FA    "
-HFILE_FORMAT_FG = "FA    "
-HFILE_FORMAT_LSM = "FA    "
-HFILE_FORMAT_CLIM = "FA    "
-PERROBS_M = (/1.0,0.1,0.4,0.2,0.1/)
-PQCOBS_M = (/999.,999.,999.,999.,999./)
-KNCO = (/1,1,0,0,0/)
-OOBSNAT = .FALSE.
-!
-KIVAR = 1
-KVAR = 4
-HVAR_M = (/"WG2","WG1","TG2","TG1","LAI"/)
-HPREFIX_M = (/"","","","",""/)
-PSIGMA_M = (/0.15,0.1,2.0,2.0,0.2/)
-PTPRT_M = (/0.0001,0.0001,0.00001,0.00001,0.001/)
-KNCV = (/1,1,1,1,1/)
-PSCALE_Q = 0.125
-PSCALE_QLAI = 0.5
-HBIO = "BIOMA1"
-HPREFIX_BIO = ""
-PALPH = (/0., 0., 0., 0.08203445, 0.07496252, 0.06846970, 0.06771856, 0.09744689, &
-          0.09744689, 0.07164350, 0.17686594, 0.07164350/)
-!
-KENS = 1
-KIE = 0
-PASSIM_WINH = 24
-PINFL_M = (/0.,0.,0.,0.,0./)
-PADDINFL_M = (/0.,0.,0.,0.,0./)
-PADDTIMECORR_M = (/0.,0.,0.,0.,0./)
-OENKF = .FALSE.
-ODENKF = .FALSE.
-OENS_GEN = .TRUE.
-OPB_CORRELATIONS = .FALSE.
-OPERTURBATION_RUN = .FALSE.
-OBIAS_CORRECTION = .FALSE.
-!
-IF (LHOOK) CALL DR_HOOK('DEFAULT_ASSIM',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE DEFAULT_ASSIM
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier\r
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence\r
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!SFX_LIC for details. version 1.\r
+!     #########\r
+      SUBROUTINE DEFAULT_ASSIM(OASSIM,HASSIM,HASSIM_ISBA,KPRINTLEV,         &\r
+                               OAROME,OECSST,OAESST,OAESNM,                 &\r
+                               OALADSURF,OREAD_SST_FROM_FILE,               &\r
+                               HFILE_FORMAT_SST,OEXTRAP_SEA,                &\r
+                               OEXTRAP_WATER,OEXTRAP_NATURE,                &\r
+                               OWATERTG2,KBOUTPUT,KECHGU,PRCLIMCA,          &\r
+                               PRCLISST,PSIGH2MO,PSIGT2MO,PSIGWGO,          &\r
+                               PSIGWGB,PSIGW2B,OOBSWG,OOBS2M,OIMVEG,        &\r
+                               PSPRECIP2,PRTHR_QC,PSIGWGO_MAX,              &\r
+                               PRSCAL_JAC,OPRT,OSIM,OBEV,OBFIXED,           &\r
+                               KOBSTYPE,OOBSHEADER,HFILE_FORMAT_OBS,OOBSNAT,&\r
+                               HFILE_FORMAT_FG,HFILE_FORMAT_LSM,            &\r
+                               HFILE_FORMAT_CLIM,PERROBS_M,PQCOBS_M,        &\r
+                               KNCO,KIVAR,KVAR,HVAR_M,HPREFIX_M,            &\r
+                               PSIGMA_M,PTPRT_M,KNCV,PSCALE_Q,              &\r
+                               PSCALE_QLAI,HBIO,HPREFIX_BIO,PALPH,          &\r
+                               KENS,KIE,PINFL_M,PADDINFL_M, PASSIM_WINH,    &\r
+                               PADDTIMECORR_M,OENS_GEN,OPB_CORRELATIONS,    &\r
+                               OPERTURBATION_RUN,OBIAS_CORRECTION,          &\r
+                               OENKF,ODENKF,HTEST)\r
+!     ########################################################################\r
+!\r
+!!****  *DEFAULT_ISBA* - routine to set default values for the configuration for ISBA assimilation scheme\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!\r
+!!\r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!\r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!      L. Jarlan  *Meteo France*\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original    02/2005\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!              ------------\r
+!\r
+USE MODI_ABOR1_SFX\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+USE MODD_ASSIM, ONLY : NOBSMAX, NVARMAX\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1   Declarations of arguments\r
+!              -------------------------\r
+LOGICAL,           INTENT(OUT) :: OASSIM        ! assimilation or not\r
+ CHARACTER(LEN=5),  INTENT(OUT) :: HASSIM        ! type of corrections PLUS/2DVAR\r
+ CHARACTER(LEN=5),  INTENT(OUT) :: HASSIM_ISBA\r
+INTEGER,           INTENT(OUT) :: KPRINTLEV\r
+LOGICAL,           INTENT(OUT) :: OAROME\r
+LOGICAL,           INTENT(OUT) :: OECSST\r
+LOGICAL,           INTENT(OUT) :: OAESST\r
+LOGICAL,           INTENT(OUT) :: OAESNM\r
+LOGICAL,           INTENT(OUT) :: OALADSURF\r
+LOGICAL,           INTENT(OUT) :: OREAD_SST_FROM_FILE\r
+ CHARACTER(LEN=6),  INTENT(OUT) :: HFILE_FORMAT_SST\r
+LOGICAL,           INTENT(OUT) :: OEXTRAP_SEA\r
+LOGICAL,           INTENT(OUT) :: OEXTRAP_WATER\r
+LOGICAL,           INTENT(OUT) :: OEXTRAP_NATURE\r
+LOGICAL,           INTENT(OUT) :: OWATERTG2\r
+INTEGER,           INTENT(OUT) :: KBOUTPUT\r
+!\r
+INTEGER,           INTENT(OUT) :: KECHGU\r
+REAL,              INTENT(OUT) :: PRCLIMCA\r
+REAL,              INTENT(OUT) :: PRCLISST\r
+REAL,              INTENT(OUT) :: PSIGH2MO\r
+REAL,              INTENT(OUT) :: PSIGT2MO\r
+REAL,              INTENT(OUT) :: PSIGWGO\r
+REAL,              INTENT(OUT) :: PSIGWGB\r
+REAL,              INTENT(OUT) :: PSIGW2B\r
+LOGICAL,           INTENT(OUT) :: OOBSWG\r
+LOGICAL,           INTENT(OUT) :: OOBS2M\r
+LOGICAL,           INTENT(OUT) :: OIMVEG\r
+REAL,              INTENT(OUT) :: PSPRECIP2 \r
+REAL,              INTENT(OUT) :: PRTHR_QC\r
+REAL,              INTENT(OUT) :: PSIGWGO_MAX\r
+REAL,              INTENT(OUT) :: PRSCAL_JAC\r
+!\r
+LOGICAL,           INTENT(OUT) :: OPRT\r
+LOGICAL,           INTENT(OUT) :: OSIM\r
+LOGICAL,           INTENT(OUT) :: OBEV\r
+LOGICAL,           INTENT(OUT) :: OBFIXED\r
+!\r
+INTEGER,             INTENT(OUT) :: KOBSTYPE\r
+LOGICAL,             INTENT(OUT) :: OOBSHEADER\r
+ CHARACTER(LEN=6),    INTENT(OUT) :: HFILE_FORMAT_OBS\r
+ CHARACTER(LEN=6),    INTENT(OUT) :: HFILE_FORMAT_FG\r
+ CHARACTER(LEN=6),    INTENT(OUT) :: HFILE_FORMAT_LSM\r
+ CHARACTER(LEN=6),    INTENT(OUT) :: HFILE_FORMAT_CLIM\r
+REAL, DIMENSION(NOBSMAX),    INTENT(OUT) :: PERROBS_M\r
+REAL, DIMENSION(NOBSMAX),    INTENT(OUT) :: PQCOBS_M\r
+INTEGER, DIMENSION(NOBSMAX), INTENT(OUT) :: KNCO\r
+LOGICAL, INTENT(OUT) :: OOBSNAT\r
+!\r
+INTEGER,           INTENT(OUT) :: KIVAR\r
+INTEGER,           INTENT(OUT) :: KVAR\r
+ CHARACTER(LEN=3),  DIMENSION(NVARMAX), INTENT(OUT) :: HVAR_M\r
+ CHARACTER(LEN=100),  DIMENSION(NVARMAX), INTENT(OUT) :: HPREFIX_M\r
+REAL, DIMENSION(NVARMAX), INTENT(OUT) :: PSIGMA_M\r
+REAL, DIMENSION(NVARMAX), INTENT(OUT) :: PTPRT_M\r
+INTEGER, DIMENSION(NVARMAX), INTENT(OUT) :: KNCV\r
+REAL,                INTENT(OUT) :: PSCALE_Q\r
+REAL,                INTENT(OUT) :: PSCALE_QLAI\r
+ CHARACTER(LEN=LEN_HREC),   INTENT(OUT) :: HBIO\r
+ CHARACTER(LEN=100),  INTENT(OUT) :: HPREFIX_BIO\r
+REAL, DIMENSION(12), INTENT(OUT) :: PALPH\r
+!\r
+INTEGER, INTENT(OUT) :: KENS\r
+INTEGER, INTENT(OUT) :: KIE\r
+REAL, INTENT(OUT) :: PASSIM_WINH\r
+REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PINFL_M\r
+REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PADDINFL_M\r
+REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PADDTIMECORR_M\r
+LOGICAL, INTENT(OUT) :: OENKF\r
+LOGICAL, INTENT(OUT) :: ODENKF\r
+LOGICAL, INTENT(OUT) :: OENS_GEN\r
+LOGICAL, INTENT(OUT) :: OPB_CORRELATIONS\r
+LOGICAL, INTENT(OUT) :: OPERTURBATION_RUN\r
+LOGICAL, INTENT(OUT) :: OBIAS_CORRECTION\r
+ CHARACTER(LEN=2),   INTENT(IN) :: HTEST\r
+!\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!\r
+!-------------------------------------------------------------------------------\r
+IF (LHOOK) CALL DR_HOOK('DEFAULT_ASSIM',0,ZHOOK_HANDLE)\r
+\r
+IF (HTEST/='OK') THEN\r
+  CALL ABOR1_SFX('default_assim: FATAL ERROR DURING ARGUMENT TRANSFER')\r
+END IF\r
+\r
+!\r
+OASSIM    = .FALSE.\r
+HASSIM    = "PLUS "\r
+HASSIM_ISBA = "OI" \r
+KPRINTLEV = 0\r
+OAROME    = .TRUE.\r
+OECSST    = .FALSE.\r
+OAESST    = .FALSE.\r
+OAESNM    = .FALSE.\r
+OALADSURF = .TRUE.\r
+OREAD_SST_FROM_FILE=.FALSE.\r
+HFILE_FORMAT_SST = "FA    "\r
+OEXTRAP_SEA    = .TRUE.\r
+OEXTRAP_WATER  = .TRUE.\r
+OEXTRAP_NATURE = .FALSE.\r
+OWATERTG2      = .FALSE.\r
+\r
+KBOUTPUT = 1\r
+!\r
+KECHGU = 6\r
+!  RCLIMCA : coef. de rappel vers la climatologie des champs de surface\r
+!  RCLISST : coef. de rappel vers la climatologie de SST\r
+!PRCLIMCA=0.045\r
+PRCLIMCA = 0. ! no climatology relaxation\r
+!PRCLISST=0.05 ! as in the original cacsts\r
+PRCLISST = 0.05 \r
+!***  SIGT2MO : ecart-type d'erreur "d'observation" sur T2m\r
+!***  SIGH2MO : ecart-type d'erreur "d'observation" sur Hu2m\r
+PSIGH2MO = 0.1 ! observation error for HU2m\r
+PSIGT2MO = 1.0 ! observation error for T2m\r
+PSIGWGO = 0.06 ! observation error for WG\r
+PSIGWGB = 0.06 ! background error for WG\r
+PSIGW2B = 0.03 ! background error for W2\r
+OOBSWG = .TRUE. ! assimilation of WG\r
+OOBS2M = .FALSE. ! assimilation of T2M + RH2M (with WG)\r
+!     LIMVEG : activation de la limitation a wp > veg*wwilt\r
+!***  LIMVEG  : si wp >= veg*wwilt\r
+OIMVEG = .TRUE.\r
+PSPRECIP2 = 4.0\r
+PRTHR_QC = 3.0\r
+PSIGWGO_MAX = 6.0 ! maximum acceptable WG obs error (%) \r
+PRSCAL_JAC = 4.0  ! to modify the "effective" assimilation window\r
+!\r
+! Initialization of EKF\r
+OPRT = .FALSE.\r
+OSIM = .FALSE.\r
+OBEV = .TRUE.\r
+OBFIXED = .FALSE.\r
+!\r
+KOBSTYPE = 2\r
+OOBSHEADER = .FALSE.\r
+HFILE_FORMAT_OBS = "FA    "\r
+HFILE_FORMAT_FG = "FA    "\r
+HFILE_FORMAT_LSM = "FA    "\r
+HFILE_FORMAT_CLIM = "FA    "\r
+PERROBS_M = (/1.0,0.1,0.4,0.2,0.1/)\r
+PQCOBS_M = (/999.,999.,999.,999.,999./)\r
+KNCO = (/1,1,0,0,0/)\r
+OOBSNAT = .FALSE.\r
+!\r
+KIVAR = 1\r
+KVAR = 4\r
+HVAR_M = (/"WG2","WG1","TG2","TG1","LAI"/)\r
+HPREFIX_M = (/"","","","",""/)\r
+PSIGMA_M = (/0.15,0.1,2.0,2.0,0.2/)\r
+PTPRT_M = (/0.0001,0.0001,0.00001,0.00001,0.001/)\r
+KNCV = (/1,1,1,1,1/)\r
+PSCALE_Q = 0.125\r
+PSCALE_QLAI = 0.5\r
+HBIO = "BIOMA1"\r
+HPREFIX_BIO = ""\r
+PALPH = (/0., 0., 0., 0.08203445, 0.07496252, 0.06846970, 0.06771856, 0.09744689, &\r
+          0.09744689, 0.07164350, 0.17686594, 0.07164350/)\r
+!\r
+KENS = 1\r
+KIE = 0\r
+PASSIM_WINH = 24\r
+PINFL_M = (/0.,0.,0.,0.,0./)\r
+PADDINFL_M = (/0.,0.,0.,0.,0./)\r
+PADDTIMECORR_M = (/0.,0.,0.,0.,0./)\r
+OENKF = .FALSE.\r
+ODENKF = .FALSE.\r
+OENS_GEN = .TRUE.\r
+OPB_CORRELATIONS = .FALSE.\r
+OPERTURBATION_RUN = .FALSE.\r
+OBIAS_CORRECTION = .FALSE.\r
+!\r
+IF (LHOOK) CALL DR_HOOK('DEFAULT_ASSIM',1,ZHOOK_HANDLE)\r
+!\r
+END SUBROUTINE DEFAULT_ASSIM\r
index 6d5a5d8..ed4fd6a 100644 (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.
-!GLT_LIC The GELATO model is a seaice model used in stand-alone or embedded mode. 
-!GLT_LIC  It has been developed by Meteo-France. The holder of GELATO is Meteo-France.
-!GLT_LIC  
-!GLT_LIC  This software is governed by the CeCILL-C license under French law and biding
-!GLT_LIC  by the rules of distribution of free software. See the CeCILL-C_V1-en.txt
-!GLT_LIC  (English) and CeCILL-C_V1-fr.txt (French) for details. The CeCILL is a free
-!GLT_LIC  software license, explicitly compatible with the GNU GPL
-!GLT_LIC  (see http://www.gnu.org/licenses/license-list.en.html#CeCILL)
-!GLT_LIC  
-!GLT_LIC  The CeCILL-C licence agreement grants users the right to modify and re-use the
-!GLT_LIC  software governed by this free software license. The exercising of this right
-!GLT_LIC  is conditional upon the obligation to make available to the community the
-!GLT_LIC  modifications made to the source code of the software so as to contribute to
-!GLT_LIC  its evolution.
-!GLT_LIC  
-!GLT_LIC  In consideration of access to the source code and the rights to copy, modify
-!GLT_LIC  and redistribute granted by the license, users are provided only with a limited
-!GLT_LIC  warranty and the software's author, the holder of the economic rights, and the
-!GLT_LIC  successive licensors only have limited liability. In this respect, the risks
-!GLT_LIC  associated with loading, using, modifying and/or developing or reproducing the
-!GLT_LIC  software by the user are brought to the user's attention, given its Free
-!GLT_LIC  Software status, which may make it complicated to use, with the result that its
-!GLT_LIC  use is reserved for developers and experienced professionals having in-depth
-!GLT_LIC  computer knowledge. Users are therefore encouraged to load and test the
-!GLT_LIC  suitability of the software as regards their requirements in conditions enabling
-!GLT_LIC  the security of their systems and/or data to be ensured and, more generally, to
-!GLT_LIC  use and operate it in the same conditions of security. 
-!GLT_LIC  
-!GLT_LIC  The GELATO sofware is cureently distibuted with the SURFEX software, available at 
-!GLT_LIC  http://www.cnrm.meteo.fr/surfex. The fact that you download the software deemed that
-!GLT_LIC  you had knowledge of the CeCILL-C license and that you accept its terms.
-!GLT_LIC  Attempts to use this software in a way not complying with CeCILL-C license
-!GLT_LIC  may lead to prosecution. 
-!GLT_LIC 
-! =======================================================================
-! ======================== MODULE modi_glt_updasn_r =========================
-! =======================================================================
-!
-! Goal:
-! -----
-!   This module contains a subroutine that is used to update snow 
-! albedo, depending on wheather conditions.
-!
-! IMPORTANT NOTICE: this routine should be placed just after the
-! vertical heat diffusion, before a correction on snow temperature
-! MAX( T_melt, T_snow) was applied.
-!
-! Created : 2001/08 (D. Salas y Melia)
-!           Taken out from thermo_ice, which used to do this job. 
-! Modified: 2009/06 (D. Salas y Melia)
-!           Reduced grid
-! Modified: 2010/02 (D. Salas y Melia)
-!           - Rain is no longer considered here.
-!           - bare thin ice albedo coefficients are adapted from
-!          Flato and Brown (1996) - see also Curry et. al (2001)
-!           - Douville et al. (1995) snow ageing parameterisations are
-!          removed 
-! Modified: 2012/01 (M. Chevallier & D. Salas y Melia)
-!           A melt pond parameterization is included (updaponds_r).
-!
-!           IF THE MELT POND PARAMETERIZATION IS DISABLED:
-!
-!           *************** (3)  snow cover: asn=asnow if hsnow>val else asi
-!
-!           ----___------__ (2.1 + 2.3)  bare ice+melt ponds: asi=albimlt if
-!                                        ice surface is melting, else asi=asi(hi)
-!
-!           IF THE MELT POND PARAMETERIZATION IS ENABLED:
-!
-!           *************** (3)  snow cover: asn=asnow if hsnow>val else asi
-!
-!           ________    ___ (2.2) melt ponds: asi=fmp*abi + (1-fmp)*amp
-!           --------------- (2.1) bare ice:   asi=abi if ice surface is melting, 
-!                                 else asi=asi(hi)
-!
-! --------------------- BEGIN MODULE modi_glt_updasn_r ----------------------
-!
-!THXS_SFX!MODULE modi_glt_updasn_r
-!THXS_SFX!INTERFACE 
-!THXS_SFX!!
-!THXS_SFX!SUBROUTINE glt_updasn_r( gsmelt,tpatm,tpblki,pvsp,tpsit,tpdia )
-!THXS_SFX!  USE modd_types_glt
-!THXS_SFX!  USE modd_glt_param
-!THXS_SFX!  LOGICAL, DIMENSION(nt,np), INTENT(in) ::  &
-!THXS_SFX!        gsmelt
-!THXS_SFX!  TYPE(t_atm), DIMENSION(np), INTENT(in) ::  &
-!THXS_SFX!        tpatm   
-!THXS_SFX!  TYPE(t_blk), DIMENSION(nt,np), INTENT(in) ::  &
-!THXS_SFX!        tpblki
-!THXS_SFX!  REAL, DIMENSION(nl,nt,np), INTENT(in) ::  &
-!THXS_SFX!        pvsp
-!THXS_SFX!  TYPE(t_sit), DIMENSION(nt,np), INTENT(inout) ::  &
-!THXS_SFX!        tpsit   
-!THXS_SFX!  TYPE(t_dia), DIMENSION(np), INTENT(inout) ::  &
-!THXS_SFX!        tpdia   
-!THXS_SFX!END SUBROUTINE glt_updasn_r
-!THXS_SFX!!
-!THXS_SFX!END INTERFACE
-!THXS_SFX!END MODULE modi_glt_updasn_r
-!
-! ---------------------- END MODULE modi_glt_updasn_r -----------------------
-!
-!
-!
-! -----------------------------------------------------------------------
-! ------------------------- SUBROUTINE glt_updasn_r -------------------------
-!
-! * Subroutine used to update snow albedo (takes into account snow or
-! thermodynamic surface melting). 
-! * (ASN = Albedo SNow)
-!
-SUBROUTINE glt_updasn_r( gsmelt,tpatm,tpblki,pvsp,tpsit,tpdia )
-!
-  USE modd_glt_const_thm
-  USE modd_types_glt
-  USE modd_glt_param
-!
-  IMPLICIT NONE
-!
-  LOGICAL, DIMENSION(nt,np), INTENT(in) ::  &
-        gsmelt
-  TYPE(t_atm), DIMENSION(np), INTENT(in) ::  &
-        tpatm   
-  TYPE(t_blk), DIMENSION(nt,np), INTENT(in) ::  &
-        tpblki
-  REAL, DIMENSION(nl,nt,np), INTENT(in) ::  &
-        pvsp
-  TYPE(t_sit), DIMENSION(nt,np), INTENT(inout) ::  &
-        tpsit   
-  TYPE(t_dia), DIMENSION(np), INTENT(inout) ::  &
-        tpdia   
-!
-  LOGICAL, DIMENSION(nt,np) ::  &
-        gsnmelt,gsimelt
-  REAL ::  &
-        zhsicr
-  REAL, DIMENSION(np) ::  &
-        zfsit
-  REAL, DIMENSION(nt,np) ::  &
-        zpcps,zpcpr,zasi,zasn,zent0,zalf,zt
-!
-!
-!
-! 1. Initializations
-! ==================
-!
-! .. Compute critical thickness (where albedo parameterization for thin ice
-! reaches standard sea ice albedo)
-!
-  zhsicr = ( ( albi-albw )/xalf1 )**( 1./xpow )
-!
-! .. Initialize ancillary real arrays
-!
-! Sea ice and snow albedo
-  zasi(:,:) = 0.
-  zasn(:,:) = 0.
-!
-! Melting point gltools_enthalpy
-  zent0 = -cpsw*mu*pvsp(nilay,:,:)
-!
-! .. Initialize sea ice and snow melting flags (criterion: as this routine is 
-! placed just after the heat diffusion scheme, without any correction
-! on snow temperature, all slabs with T_snow > tice_m are melting)
-!
-  gsnmelt = .FALSE.
-  WHERE( tpsit(:,:)%hsn>=epsil1 .AND. gsmelt(:,:) )
-    gsnmelt(:,:) = .TRUE.
-  ENDWHERE
-!
-  gsimelt(:,:) = .FALSE.
-  WHERE( tpsit(:,:)%hsi > 0.1 .AND. tpsit(:,:)%hsn < epsil1 .AND. gsmelt(:,:) )
-    gsimelt(:,:) = .TRUE.
-  ENDWHERE
-!
-! .. Compute the amount of fallen precipitation.
-!
-  zpcps(:,:) = SPREAD( tpatm(:)%sop,1,nt )
-  zpcpr(:,:) = SPREAD( tpatm(:)%lip,1,nt )
-!
-!
-!
-! 2. Compute the albedo of snow-free ice
-! ======================================
-!
-! 2.1. Albedo of bare, non-melting sea ice (without ponds)
-! ---------------------------------------------------------
-!
-! The ice-thickness dependence of bare sea ice albedo was eliminated in this version
-! While based on physical grounds for young sea ice, this thickness dependence is
-! clearly not valid for old, thinning sea ice.
-! The lower albedo of young sea ice is due to the fact this ice tends to be 
-! rather translucid. However, the SW radiation transmission coefficient though
-! sea ice does not take into account the fact sea ice is more or less translucid.
-! Actually, this parameterization probably caused the sea ice to absorb too much 
-! SW radiation.
-! So here we prefer simply assuming the albedo of melting sea ice is just equal to
-! a standard value (albi)
-!
-!  IF ( niceage==1 ) THEN
-!    zalf(:,:) = EXP( - MAX( tpsit(:,:)%age/xmonth2sec-6.,0. ) )
-!  ELSE
-!    zalf(:,:) = 1.
-!  ENDIF 
-!  zalf(:,:) = albyngi * zalf(:,:)
-!!
-!  WHERE( tpsit(:,:)%hsi<zhsicr )
-!    zt(:,:) = tpsit(:,:)%hsi
-!    zasi(:,:) = zalf(:,:) * ( xalf1*AMAX1( zt(:,:),0. )**xpow + albw ) +  &
-!      ( 1.-zalf(:,:) ) * albi
-!!
-!! .. No thermodynamic surface melting on thick ice without snow.
-!! The albedo is set to bare ice albedo.
-!!
-!  ELSEWHERE
-!    zasi(:,:) = albi
-!!
-!  ENDWHERE
-!
-  zasi(:,:) = albi
-!
-!
-! 2.2. Albedo of bare, melting sea ice (pond parameterization is enabled)
-! ------------------------------------------------------------------------
-!
-! .. Thermodynamic surface melting on ice without snow.
-! The albedo is set to melting ice albedo.
-!
-  IF ( nmponds==1) THEN
-! .. Melt pond case: melting bare ice albedo is considered as a physical
-! constant (=0.65).
-!
-    WHERE( gsimelt(:,:) )
-      zasi(:,:) = AMIN1( zasi(:,:),xalbareimlt )
-    ENDWHERE
-! .. Invoke the pond parameterization. The melting ice surface consists in a fraction (fmp) 
-! covered with meltwater ponds, and in melting bare ice (1-fmp). This parameterization 
-! updates the global melting ice albedo.
-!
-    CALL gltools_updaponds_r(gsmelt,tpatm,tpblki,tpdia,tpsit,zasi)
-  ELSE
-!
-!
-! 2.3. Albedo of bare, melting sea ice (pond parameterization is disabled)
-! -------------------------------------------------------------------------
-!
-! .. In this case, melting ice surface is a mix of melting bare ice and melt ponds.
-! Melting ice albedo is prescribed as a "tuning" parameter.
-    WHERE( gsimelt(:,:) )
-      zasi(:,:) = AMIN1( zasi(:,:),albimlt )
-    ENDWHERE
-!
-  ENDIF
-!
-!
-!
-! 3. Compute the albedo of the snow covered part of the ice
-! =========================================================
-!
-! 3.1. Determine the initial snow albedo
-! --------------------------------------
-!
-! .. Now compute albedo of the snow covered part of the ice slab from:
-!       - initial averaged snow+bare ice albedo, tpsit%asn
-!       - computed bare ice albedo, zasi
-!       - snow thickness, tpsit%hsn
-!
-  zt(:,:) = tpsit(:,:)%rsn*tpsit(:,:)%hsn / rhofw
-  zalf(:,:) = AMIN1( zt(:,:)/wnew,1. )
-!
-! .. Snow cover albedo: melting and dry snow cases
-!
-  WHERE( gsnmelt(:,:) )
-    zasn(:,:) = albsmlt
-  ELSEWHERE
-    zasn(:,:) = albsdry 
-  ENDWHERE
-!
-! 
-! 3.2. Case of new snow falls
-! ----------------------------
-!
-! .. Snow accumulation : albedo is refreshed to its maximum value if 
-! snow amount reaches a threshold wnew. If new snow thickness is less 
-! than wnew, a linear combination of initial snow surface albedo and 
-! maximum snow albedo gives new albedo.   
-!
-  WHERE ( zpcps(:,:)>zpcpr(:,:) )
-      zasn(:,:) = albsdry
-  ENDWHERE
-!
-!
-!
-! 4. Weighted surface albedo (snow covered + bare ice parts of the slab)
-! =======================================================================
-!
-! .. Now that albedos were computed both on a sea ice slab with and 
-! without snow, the global surface albedo will be recomposed to take
-! into account the fact that a thin snow cover does not actually cover
-! the entire slab. 
-!
-  tpsit(:,:)%asn =  &
-    zalf(:,:)*zasn(:,:) + (1.-zalf(:,:))*zasi(:,:)
-!
-! .. For AR5 diagnostics: weighted bare sea ice albedo
-! Weights for final computation of the average bare ice albedo 
-! [i.e. SUM(ftot)] must be incremented here, not where diagnostics 
-! are writtenSUM(ftot))
-!   The reason for this is that tpsit%fsi in the present routine would
-! not be consistent with total sea ice fraction in the diagnostics.
-!
-!* Accumulate sea ice fraction
-  zfsit(:) = SUM( tpsit(:,:)%fsi, DIM=1 )
-  tpdia(:)%aiw = tpdia(:)%aiw + zfsit(:)
-!* Ice surface albedo (bare ice + melt ponds)
-  tpdia(:)%asi = SUM( tpsit(:,:)%fsi*zasi(:,:),DIM=1 )
-!* Snow albedo: approximation (suppose zalf is generally close to 1)
-  tpdia(:)%asn = SUM( tpsit(:,:)%fsi*zasn(:,:),DIM=1 )
-!
-END SUBROUTINE glt_updasn_r
-!
-! ---------------------- END SUBROUTINE glt_updasn_r ------------------------
-! -----------------------------------------------------------------------
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier\r
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence\r
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!SFX_LIC for details. version 1.\r
+!GLT_LIC The GELATO model is a seaice model used in stand-alone or embedded mode. \r
+!GLT_LIC  It has been developed by Meteo-France. The holder of GELATO is Meteo-France.\r
+!GLT_LIC  \r
+!GLT_LIC  This software is governed by the CeCILL-C license under French law and biding\r
+!GLT_LIC  by the rules of distribution of free software. See the CeCILL-C_V1-en.txt\r
+!GLT_LIC  (English) and CeCILL-C_V1-fr.txt (French) for details. The CeCILL is a free\r
+!GLT_LIC  software license, explicitly compatible with the GNU GPL\r
+!GLT_LIC  (see http://www.gnu.org/licenses/license-list.en.html#CeCILL)\r
+!GLT_LIC  \r
+!GLT_LIC  The CeCILL-C licence agreement grants users the right to modify and re-use the\r
+!GLT_LIC  software governed by this free software license. The exercising of this right\r
+!GLT_LIC  is conditional upon the obligation to make available to the community the\r
+!GLT_LIC  modifications made to the source code of the software so as to contribute to\r
+!GLT_LIC  its evolution.\r
+!GLT_LIC  \r
+!GLT_LIC  In consideration of access to the source code and the rights to copy, modify\r
+!GLT_LIC  and redistribute granted by the license, users are provided only with a limited\r
+!GLT_LIC  warranty and the software's author, the holder of the economic rights, and the\r
+!GLT_LIC  successive licensors only have limited liability. In this respect, the risks\r
+!GLT_LIC  associated with loading, using, modifying and/or developing or reproducing the\r
+!GLT_LIC  software by the user are brought to the user's attention, given its Free\r
+!GLT_LIC  Software status, which may make it complicated to use, with the result that its\r
+!GLT_LIC  use is reserved for developers and experienced professionals having in-depth\r
+!GLT_LIC  computer knowledge. Users are therefore encouraged to load and test the\r
+!GLT_LIC  suitability of the software as regards their requirements in conditions enabling\r
+!GLT_LIC  the security of their systems and/or data to be ensured and, more generally, to\r
+!GLT_LIC  use and operate it in the same conditions of security. \r
+!GLT_LIC  \r
+!GLT_LIC  The GELATO sofware is cureently distibuted with the SURFEX software, available at \r
+!GLT_LIC  http://www.cnrm.meteo.fr/surfex. The fact that you download the software deemed that\r
+!GLT_LIC  you had knowledge of the CeCILL-C license and that you accept its terms.\r
+!GLT_LIC  Attempts to use this software in a way not complying with CeCILL-C license\r
+!GLT_LIC  may lead to prosecution. \r
+!GLT_LIC \r
+! =======================================================================\r
+! ======================== MODULE modi_glt_updasn_r =========================\r
+! =======================================================================\r
+!\r
+! Goal:\r
+! -----\r
+!   This module contains a subroutine that is used to update snow \r
+! albedo, depending on wheather conditions.\r
+!\r
+! IMPORTANT NOTICE: this routine should be placed just after the\r
+! vertical heat diffusion, before a correction on snow temperature\r
+! MAX( T_melt, T_snow) was applied.\r
+!\r
+! Created : 2001/08 (D. Salas y Melia)\r
+!           Taken out from thermo_ice, which used to do this job. \r
+! Modified: 2009/06 (D. Salas y Melia)\r
+!           Reduced grid\r
+! Modified: 2010/02 (D. Salas y Melia)\r
+!           - Rain is no longer considered here.\r
+!           - bare thin ice albedo coefficients are adapted from\r
+!          Flato and Brown (1996) - see also Curry et. al (2001)\r
+!           - Douville et al. (1995) snow ageing parameterisations are\r
+!          removed \r
+! Modified: 2012/01 (M. Chevallier & D. Salas y Melia)\r
+!           A melt pond parameterization is included (updaponds_r).\r
+!\r
+!           IF THE MELT POND PARAMETERIZATION IS DISABLED:\r
+!\r
+!           *************** (3)  snow cover: asn=asnow if hsnow>val else asi\r
+!\r
+!           ----___------__ (2.1 + 2.3)  bare ice+melt ponds: asi=albimlt if\r
+!                                        ice surface is melting, else asi=asi(hi)\r
+!\r
+!           IF THE MELT POND PARAMETERIZATION IS ENABLED:\r
+!\r
+!           *************** (3)  snow cover: asn=asnow if hsnow>val else asi\r
+!\r
+!           ________    ___ (2.2) melt ponds: asi=fmp*abi + (1-fmp)*amp\r
+!           --------------- (2.1) bare ice:   asi=abi if ice surface is melting, \r
+!                                 else asi=asi(hi)\r
+!\r
+! --------------------- BEGIN MODULE modi_glt_updasn_r ----------------------\r
+!\r
+!THXS_SFX!MODULE modi_glt_updasn_r\r
+!THXS_SFX!INTERFACE \r
+!THXS_SFX!!\r
+!THXS_SFX!SUBROUTINE glt_updasn_r( gsmelt,tpatm,tpblki,pvsp,tpsit,tpdia )\r
+!THXS_SFX!  USE modd_types_glt\r
+!THXS_SFX!  USE modd_glt_param\r
+!THXS_SFX!  LOGICAL, DIMENSION(nt,np), INTENT(in) ::  &\r
+!THXS_SFX!        gsmelt\r
+!THXS_SFX!  TYPE(t_atm), DIMENSION(np), INTENT(in) ::  &\r
+!THXS_SFX!        tpatm   \r
+!THXS_SFX!  TYPE(t_blk), DIMENSION(nt,np), INTENT(in) ::  &\r
+!THXS_SFX!        tpblki\r
+!THXS_SFX!  REAL, DIMENSION(nl,nt,np), INTENT(in) ::  &\r
+!THXS_SFX!        pvsp\r
+!THXS_SFX!  TYPE(t_sit), DIMENSION(nt,np), INTENT(inout) ::  &\r
+!THXS_SFX!        tpsit   \r
+!THXS_SFX!  TYPE(t_dia), DIMENSION(np), INTENT(inout) ::  &\r
+!THXS_SFX!        tpdia   \r
+!THXS_SFX!END SUBROUTINE glt_updasn_r\r
+!THXS_SFX!!\r
+!THXS_SFX!END INTERFACE\r
+!THXS_SFX!END MODULE modi_glt_updasn_r\r
+!\r
+! ---------------------- END MODULE modi_glt_updasn_r -----------------------\r
+!\r
+!\r
+!\r
+! -----------------------------------------------------------------------\r
+! ------------------------- SUBROUTINE glt_updasn_r -------------------------\r
+!\r
+! * Subroutine used to update snow albedo (takes into account snow or\r
+! thermodynamic surface melting). \r
+! * (ASN = Albedo SNow)\r
+!\r
+SUBROUTINE glt_updasn_r( gsmelt,tpatm,tpblki,pvsp,tpsit,tpdia )\r
+!\r
+  USE modd_glt_const_thm\r
+  USE modd_types_glt\r
+  USE modd_glt_param\r
+  USE modi_gltools_updaponds_r\r
+!\r
+  IMPLICIT NONE\r
+!\r
+  LOGICAL, DIMENSION(nt,np), INTENT(in) ::  &\r
+        gsmelt\r
+  TYPE(t_atm), DIMENSION(np), INTENT(in) ::  &\r
+        tpatm   \r
+  TYPE(t_blk), DIMENSION(nt,np), INTENT(in) ::  &\r
+        tpblki\r
+  REAL, DIMENSION(nl,nt,np), INTENT(in) ::  &\r
+        pvsp\r
+  TYPE(t_sit), DIMENSION(nt,np), INTENT(inout) ::  &\r
+        tpsit   \r
+  TYPE(t_dia), DIMENSION(np), INTENT(inout) ::  &\r
+        tpdia   \r
+!\r
+  LOGICAL, DIMENSION(nt,np) ::  &\r
+        gsnmelt,gsimelt\r
+  REAL ::  &\r
+        zhsicr\r
+  REAL, DIMENSION(np) ::  &\r
+        zfsit\r
+  REAL, DIMENSION(nt,np) ::  &\r
+        zpcps,zpcpr,zasi,zasn,zent0,zalf,zt\r
+!\r
+!\r
+!\r
+! 1. Initializations\r
+! ==================\r
+!\r
+! .. Compute critical thickness (where albedo parameterization for thin ice\r
+! reaches standard sea ice albedo)\r
+!\r
+  zhsicr = ( ( albi-albw )/xalf1 )**( 1./xpow )\r
+!\r
+! .. Initialize ancillary real arrays\r
+!\r
+! Sea ice and snow albedo\r
+  zasi(:,:) = 0.\r
+  zasn(:,:) = 0.\r
+!\r
+! Melting point gltools_enthalpy\r
+  zent0 = -cpsw*mu*pvsp(nilay,:,:)\r
+!\r
+! .. Initialize sea ice and snow melting flags (criterion: as this routine is \r
+! placed just after the heat diffusion scheme, without any correction\r
+! on snow temperature, all slabs with T_snow > tice_m are melting)\r
+!\r
+  gsnmelt = .FALSE.\r
+  WHERE( tpsit(:,:)%hsn>=epsil1 .AND. gsmelt(:,:) )\r
+    gsnmelt(:,:) = .TRUE.\r
+  ENDWHERE\r
+!\r
+  gsimelt(:,:) = .FALSE.\r
+  WHERE( tpsit(:,:)%hsi > 0.1 .AND. tpsit(:,:)%hsn < epsil1 .AND. gsmelt(:,:) )\r
+    gsimelt(:,:) = .TRUE.\r
+  ENDWHERE\r
+!\r
+! .. Compute the amount of fallen precipitation.\r
+!\r
+  zpcps(:,:) = SPREAD( tpatm(:)%sop,1,nt )\r
+  zpcpr(:,:) = SPREAD( tpatm(:)%lip,1,nt )\r
+!\r
+!\r
+!\r
+! 2. Compute the albedo of snow-free ice\r
+! ======================================\r
+!\r
+! 2.1. Albedo of bare, non-melting sea ice (without ponds)\r
+! ---------------------------------------------------------\r
+!\r
+! The ice-thickness dependence of bare sea ice albedo was eliminated in this version\r
+! While based on physical grounds for young sea ice, this thickness dependence is\r
+! clearly not valid for old, thinning sea ice.\r
+! The lower albedo of young sea ice is due to the fact this ice tends to be \r
+! rather translucid. However, the SW radiation transmission coefficient though\r
+! sea ice does not take into account the fact sea ice is more or less translucid.\r
+! Actually, this parameterization probably caused the sea ice to absorb too much \r
+! SW radiation.\r
+! So here we prefer simply assuming the albedo of melting sea ice is just equal to\r
+! a standard value (albi)\r
+!\r
+!  IF ( niceage==1 ) THEN\r
+!    zalf(:,:) = EXP( - MAX( tpsit(:,:)%age/xmonth2sec-6.,0. ) )\r
+!  ELSE\r
+!    zalf(:,:) = 1.\r
+!  ENDIF \r
+!  zalf(:,:) = albyngi * zalf(:,:)\r
+!!\r
+!  WHERE( tpsit(:,:)%hsi<zhsicr )\r
+!    zt(:,:) = tpsit(:,:)%hsi\r
+!    zasi(:,:) = zalf(:,:) * ( xalf1*AMAX1( zt(:,:),0. )**xpow + albw ) +  &\r
+!      ( 1.-zalf(:,:) ) * albi\r
+!!\r
+!! .. No thermodynamic surface melting on thick ice without snow.\r
+!! The albedo is set to bare ice albedo.\r
+!!\r
+!  ELSEWHERE\r
+!    zasi(:,:) = albi\r
+!!\r
+!  ENDWHERE\r
+!\r
+  zasi(:,:) = albi\r
+!\r
+!\r
+! 2.2. Albedo of bare, melting sea ice (pond parameterization is enabled)\r
+! ------------------------------------------------------------------------\r
+!\r
+! .. Thermodynamic surface melting on ice without snow.\r
+! The albedo is set to melting ice albedo.\r
+!\r
+  IF ( nmponds==1) THEN\r
+! .. Melt pond case: melting bare ice albedo is considered as a physical\r
+! constant (=0.65).\r
+!\r
+    WHERE( gsimelt(:,:) )\r
+      zasi(:,:) = AMIN1( zasi(:,:),xalbareimlt )\r
+    ENDWHERE\r
+! .. Invoke the pond parameterization. The melting ice surface consists in a fraction (fmp) \r
+! covered with meltwater ponds, and in melting bare ice (1-fmp). This parameterization \r
+! updates the global melting ice albedo.\r
+!\r
+    CALL gltools_updaponds_r(gsmelt,tpatm,tpblki,tpdia,tpsit,zasi)\r
+  ELSE\r
+!\r
+!\r
+! 2.3. Albedo of bare, melting sea ice (pond parameterization is disabled)\r
+! -------------------------------------------------------------------------\r
+!\r
+! .. In this case, melting ice surface is a mix of melting bare ice and melt ponds.\r
+! Melting ice albedo is prescribed as a "tuning" parameter.\r
+    WHERE( gsimelt(:,:) )\r
+      zasi(:,:) = AMIN1( zasi(:,:),albimlt )\r
+    ENDWHERE\r
+!\r
+  ENDIF\r
+!\r
+!\r
+!\r
+! 3. Compute the albedo of the snow covered part of the ice\r
+! =========================================================\r
+!\r
+! 3.1. Determine the initial snow albedo\r
+! --------------------------------------\r
+!\r
+! .. Now compute albedo of the snow covered part of the ice slab from:\r
+!       - initial averaged snow+bare ice albedo, tpsit%asn\r
+!       - computed bare ice albedo, zasi\r
+!       - snow thickness, tpsit%hsn\r
+!\r
+  zt(:,:) = tpsit(:,:)%rsn*tpsit(:,:)%hsn / rhofw\r
+  zalf(:,:) = AMIN1( zt(:,:)/wnew,1. )\r
+!\r
+! .. Snow cover albedo: melting and dry snow cases\r
+!\r
+  WHERE( gsnmelt(:,:) )\r
+    zasn(:,:) = albsmlt\r
+  ELSEWHERE\r
+    zasn(:,:) = albsdry \r
+  ENDWHERE\r
+!\r
+! \r
+! 3.2. Case of new snow falls\r
+! ----------------------------\r
+!\r
+! .. Snow accumulation : albedo is refreshed to its maximum value if \r
+! snow amount reaches a threshold wnew. If new snow thickness is less \r
+! than wnew, a linear combination of initial snow surface albedo and \r
+! maximum snow albedo gives new albedo.   \r
+!\r
+  WHERE ( zpcps(:,:)>zpcpr(:,:) )\r
+      zasn(:,:) = albsdry\r
+  ENDWHERE\r
+!\r
+!\r
+!\r
+! 4. Weighted surface albedo (snow covered + bare ice parts of the slab)\r
+! =======================================================================\r
+!\r
+! .. Now that albedos were computed both on a sea ice slab with and \r
+! without snow, the global surface albedo will be recomposed to take\r
+! into account the fact that a thin snow cover does not actually cover\r
+! the entire slab. \r
+!\r
+  tpsit(:,:)%asn =  &\r
+    zalf(:,:)*zasn(:,:) + (1.-zalf(:,:))*zasi(:,:)\r
+!\r
+! .. For AR5 diagnostics: weighted bare sea ice albedo\r
+! Weights for final computation of the average bare ice albedo \r
+! [i.e. SUM(ftot)] must be incremented here, not where diagnostics \r
+! are writtenSUM(ftot))\r
+!   The reason for this is that tpsit%fsi in the present routine would\r
+! not be consistent with total sea ice fraction in the diagnostics.\r
+!\r
+!* Accumulate sea ice fraction\r
+  zfsit(:) = SUM( tpsit(:,:)%fsi, DIM=1 )\r
+  tpdia(:)%aiw = tpdia(:)%aiw + zfsit(:)\r
+!* Ice surface albedo (bare ice + melt ponds)\r
+  tpdia(:)%asi = SUM( tpsit(:,:)%fsi*zasi(:,:),DIM=1 )\r
+!* Snow albedo: approximation (suppose zalf is generally close to 1)\r
+  tpdia(:)%asn = SUM( tpsit(:,:)%fsi*zasn(:,:),DIM=1 )\r
+!\r
+END SUBROUTINE glt_updasn_r\r
+!\r
+! ---------------------- END SUBROUTINE glt_updasn_r ------------------------\r
+! -----------------------------------------------------------------------\r
index c0f5e65..0bf7204 100644 (file)
@@ -1,29 +1,29 @@
-!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 VSLOG(PA,PLOG,N)
-!
-      USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
-      USE PARKIND1  ,ONLY : JPRB
-!
-!
-!
-
-!   COMPUTES THE LOGARITHM
-
-      IMPLICIT NONE
-
-      INTEGER :: N
-      REAL :: PA(N), PLOG(N)
-
-      INTEGER :: J
-      REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-      IF (LHOOK) CALL DR_HOOK('VSLOG',0,ZHOOK_HANDLE)
-      DO J=1,N
-        PLOG(J) = LOG(PA(J))
-      END DO
-      IF (LHOOK) CALL DR_HOOK('VSLOG',1,ZHOOK_HANDLE)
-
-      END
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier\r
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence\r
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!SFX_LIC for details. version 1.\r
+      SUBROUTINE VSLOG(PA,PLOG,N)\r
+!\r
+      USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+      USE PARKIND1  ,ONLY : JPRB\r
+!\r
+!\r
+!\r
+\r
+!   COMPUTES THE LOGARITHM\r
+\r
+      IMPLICIT NONE\r
+\r
+      INTEGER :: N\r
+      REAL :: PA(N), PLOG(N)\r
+\r
+      INTEGER :: J\r
+      REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+\r
+      IF (LHOOK) CALL DR_HOOK('VSLOG',0,ZHOOK_HANDLE)\r
+      DO J=1,N\r
+        PLOG(J) = LOG(PA(J))\r
+      END DO\r
+      IF (LHOOK) CALL DR_HOOK('VSLOG',1,ZHOOK_HANDLE)\r
+\r
+    END SUBROUTINE VSLOG\r