SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/coupling

Go to the documentation of this file.
00001 !     ###############################################################################
00002 SUBROUTINE COUPLING_TOWN_n(HPROGRAM, HCOUPLING, PTIMEC,                                      &
00003                  PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM,    &
00004                  PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,                 &
00005                  PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
00006                  PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
00007                  PTRAD, PDIR_ALB, PSCA_ALB, PEMIS,                                           &
00008                  PPEW_A_COEF, PPEW_B_COEF,                                                   &
00009                  PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &
00010                  HTEST                                                                       )  
00011 !     ###############################################################################
00012 !
00013 !!****  *COUPLING_TOWN_n * - Chooses the surface schemes for towns 
00014 !!
00015 !!    PURPOSE
00016 !!    -------
00017 !
00018 !!**  METHOD
00019 !!    ------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!      
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!     V. Masson 
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    01/2004
00032 !!------------------------------------------------------------------
00033 !
00034 USE MODD_SURF_ATM_n, ONLY : CTOWN
00035 USE MODD_CSTS,       ONLY : XTT, XCPD, XRD, XP00
00036 !
00037 ! 
00038 !
00039 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00040 USE PARKIND1  ,ONLY : JPRB
00041 !
00042 USE MODI_COUPLING_IDEAL_FLUX
00043 !
00044 USE MODI_COUPLING_TEB_OROGRAPHY_n
00045 !
00046 IMPLICIT NONE
00047 !
00048 !*      0.1    declarations of arguments
00049 !
00050  CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00051  CHARACTER(LEN=1),    INTENT(IN)  :: HCOUPLING ! type of coupling
00052                                               ! 'E' : explicit
00053                                               ! 'I' : implicit
00054 REAL,                INTENT(IN)  :: PTIMEC    ! cumulated time since beginning of simulation
00055 INTEGER,             INTENT(IN)  :: KYEAR     ! current year (UTC)
00056 INTEGER,             INTENT(IN)  :: KMONTH    ! current month (UTC)
00057 INTEGER,             INTENT(IN)  :: KDAY      ! current day (UTC)
00058 REAL,                INTENT(IN)  :: PTIME     ! current time since midnight (UTC, s)
00059 INTEGER,             INTENT(IN)  :: KI        ! number of points
00060 INTEGER,             INTENT(IN)  :: KSV       ! number of scalars
00061 INTEGER,             INTENT(IN)  :: KSW       ! number of short-wave spectral bands
00062 REAL, DIMENSION(KI), INTENT(IN)  :: PTSUN     ! solar time                    (s from midnight)
00063 REAL,                INTENT(IN)  :: PTSTEP    ! atmospheric time-step                 (s)
00064 REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! height of T,q forcing                 (m)
00065 REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! height of wind forcing                (m)
00066 !
00067 REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)
00068 REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)
00069 REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)
00070 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV     ! scalar variables
00071 !                                             ! chemistry:   first char. in HSV: '#'  (molecule/m3)
00072 !                                             !
00073  CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV  ! name of all scalar variables
00074 REAL, DIMENSION(KI), INTENT(IN)  :: PU        ! zonal wind                            (m/s)
00075 REAL, DIMENSION(KI), INTENT(IN)  :: PV        ! meridian wind                         (m/s)
00076 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct  solar radiation (on horizontal surf.)
00077 !                                             !                                       (W/m2)
00078 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
00079 !                                             !                                       (W/m2)
00080 REAL, DIMENSION(KSW),INTENT(IN)  :: PSW_BANDS ! mean wavelength of each shortwave band (m)
00081 REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH   ! zenithal angle       (radian from the vertical)
00082 REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)
00083 REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)
00084 !                                             !                                       (W/m2)
00085 REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)
00086 REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)
00087 REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)
00088 REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)
00089 REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)
00090 REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)
00091 !
00092 !
00093 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)
00094 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)
00095 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)
00096 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)
00097 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (kg/m2/s)
00098 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)
00099 !
00100 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)
00101 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band  (-)
00102 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
00103 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS     ! emissivity                            (-)
00104 !
00105 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
00106 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
00107 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
00108 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
00109 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
00110 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
00111  CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'
00112 !
00113 !*      0.2    declarations of local variables
00114 !
00115 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00116 !
00117 !-------------------------------------------------------------------------------------
00118 !
00119 !*      0.     initialization of implicit coefficients
00120 !              ---------------------------------------
00121 !
00122 IF (LHOOK) CALL DR_HOOK('COUPLING_TOWN_N',0,ZHOOK_HANDLE)
00123 !
00124 IF (CTOWN=='TEB   ') THEN 
00125   CALL COUPLING_TEB_OROGRAPHY_n(HPROGRAM, HCOUPLING,                                       &
00126                  PTSTEP, KYEAR, KMONTH, KDAY, PTIME,                                         &
00127                  KI, KSV, KSW,                                                               &
00128                  PTSUN, PZENITH, PAZIM,                                                      &
00129                  PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,                 &
00130                  PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
00131                  PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
00132                  PTRAD, PDIR_ALB, PSCA_ALB, PEMIS,                                           &
00133                  PPEW_A_COEF, PPEW_B_COEF,                                                   &
00134                  PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &
00135                  'OK'                                                                        )  
00136 ELSE IF (CTOWN=='FLUX  ') THEN
00137   CALL COUPLING_IDEAL_FLUX(HPROGRAM, HCOUPLING, PTIMEC,                                      &
00138                  PTSTEP, KYEAR, KMONTH, KDAY, PTIME,                                         &
00139                  KI, KSV, KSW,                                                               &
00140                  PTSUN, PZENITH, PAZIM,                                                      &
00141                  PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,                 &
00142                  PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
00143                  PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
00144                  PTRAD, PDIR_ALB, PSCA_ALB, PEMIS,                                           &
00145                  PPEW_A_COEF, PPEW_B_COEF,                                                   &
00146                  PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &
00147                  'OK'                                                                        )  
00148 ELSE IF (CTOWN=='NONE  ') THEN
00149   PSFTH = 0.
00150   PSFTQ = 0.
00151   PSFTS = 0.
00152   PSFU  = 0.
00153   PSFV  = 0.
00154   PSFCO2= 0.
00155 !
00156   PTRAD = XTT
00157   PDIR_ALB = 0.
00158   PSCA_ALB = 0.
00159   PEMIS   = 1.
00160 END IF
00161 IF (LHOOK) CALL DR_HOOK('COUPLING_TOWN_N',1,ZHOOK_HANDLE)
00162 !
00163 !-------------------------------------------------------------------------------------
00164 !
00165 END SUBROUTINE COUPLING_TOWN_n