SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/coupling_sean.F90
Go to the documentation of this file.
00001 !     ###############################################################################
00002 SUBROUTINE COUPLING_SEA_n(HPROGRAM, HCOUPLING, PTIMEC,                                       &
00003                  PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
00004                  PAZIM,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_SEA_n * - Chooses the surface schemes for sea   
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 : CSEA
00035 USE MODD_CSTS,       ONLY : XTT
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_SEAFLUX_OROG_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 at t  (radian from the vertical)
00082 REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH2  ! zenithal angle at t+1(radian from the vertical)
00083 REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)
00084 REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)
00085 !                                             !                                       (W/m2)
00086 REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)
00087 REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)
00088 REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)
00089 REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)
00090 REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)
00091 REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)
00092 !
00093 !
00094 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)
00095 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)
00096 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)
00097 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)
00098 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (kg/m2/s)
00099 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)
00100 !
00101 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)
00102 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band  (-)
00103 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
00104 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS     ! emissivity                            (-)
00105 !
00106 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
00107 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
00108 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
00109 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
00110 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
00111 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
00112  CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'
00113 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00114 !
00115 !*      0.2    declarations of local variables
00116 !
00117 !-------------------------------------------------------------------------------------
00118 !
00119 IF (LHOOK) CALL DR_HOOK('COUPLING_SEA_N',0,ZHOOK_HANDLE)
00120 IF (CSEA=='SEAFLX') THEN
00121   CALL COUPLING_SEAFLUX_OROG_n(HPROGRAM, HCOUPLING,                                          &
00122                  PTSTEP, KYEAR, KMONTH, KDAY, PTIME,                                         &
00123                  KI, KSV, KSW,                                                               &
00124                  PTSUN, PZENITH, PZENITH2,PAZIM,                                             &
00125                  PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,                 &
00126                  PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
00127                  PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
00128                  PTRAD, PDIR_ALB, PSCA_ALB, PEMIS,                                           &
00129                  PPEW_A_COEF, PPEW_B_COEF,                                                   &
00130                  PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &
00131                  'OK'                                                                        )  
00132 ELSE IF (CSEA=='FLUX  ') THEN
00133   CALL COUPLING_IDEAL_FLUX(HPROGRAM, HCOUPLING, PTIMEC,                                      &
00134                  PTSTEP, KYEAR, KMONTH, KDAY, PTIME,                                         &
00135                  KI, KSV, KSW,                                                               &
00136                  PTSUN, PZENITH, PAZIM,                                                      &
00137                  PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,                 &
00138                  PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
00139                  PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
00140                  PTRAD, PDIR_ALB, PSCA_ALB, PEMIS,                                           &
00141                  PPEW_A_COEF, PPEW_B_COEF,                                                   &
00142                  PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &
00143                  'OK'                                                                        )  
00144 ELSE IF (CSEA=='NONE  ') THEN
00145   PSFTH = 0.
00146   PSFTQ = 0.
00147   PSFTS = 0.
00148   PSFU  = 0.
00149   PSFV  = 0.
00150   PSFCO2= 0.
00151 !
00152   PTRAD = XTT
00153   PDIR_ALB = 0.
00154   PSCA_ALB = 0.
00155   PEMIS   = 1.
00156 END IF
00157 IF (LHOOK) CALL DR_HOOK('COUPLING_SEA_N',1,ZHOOK_HANDLE)
00158 !
00159 !-------------------------------------------------------------------------------------
00160 !
00161 END SUBROUTINE COUPLING_SEA_n