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

Go to the documentation of this file.
00001 !     #######################################################################
00002 SUBROUTINE COUPLING_ICEFLUX_n(KI, PTA, PEXNA, PRHOA, PTICE, PEXNS,             &
00003                                 PQA, PRAIN, PSNOW, PWIND, PZREF, PUREF,          &
00004                                 PPS, PTWAT, PTT, PSFTH, PSFTQ                     )  
00005 !     #######################################################################
00006 !
00007 !!****  *COUPLING_ICEFLUX_n * - Driver of the ICE_FLUX scheme   
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !
00012 !!**  METHOD
00013 !!    ------
00014 !!
00015 !!    REFERENCE
00016 !!    ---------
00017 !!      
00018 !!
00019 !!    AUTHOR
00020 !!    ------
00021 !!     B. DECHARME 
00022 !!
00023 !!    MODIFICATIONS
00024 !!    -------------
00025 !!      Original    02/2010
00026 !!---------------------------------------------------------------------
00027 !
00028 USE MODD_SURF_PAR,   ONLY : XUNDEF
00029 !
00030 USE MODI_ICE_SEA_FLUX
00031 ! 
00032 !
00033 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00034 USE PARKIND1  ,ONLY : JPRB
00035 !
00036 IMPLICIT NONE
00037 !
00038 !*      0.1    declarations of arguments
00039 !
00040 INTEGER,             INTENT(IN)  :: KI        ! number of points
00041 !
00042 REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)
00043 REAL, DIMENSION(KI), INTENT(IN)  :: PEXNA     ! Exner function at atm. level
00044 REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)
00045 REAL, DIMENSION(KI), INTENT(IN)  :: PTICE     ! Ice Surface Temperature
00046 REAL, DIMENSION(KI), INTENT(IN)  :: PEXNS     ! Exner function at sea surface
00047 REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)
00048 REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)
00049 REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)
00050 REAL, DIMENSION(KI), INTENT(IN)  :: PWIND     ! module of wind at atm. wind level
00051 REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! atm. level for temp. and humidity
00052 REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! atm. level for wind
00053 REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)
00054 REAL, DIMENSION(KI), INTENT(IN)  :: PTWAT     ! Water Surface Temperature
00055 REAL,               INTENT(IN)  :: PTT       ! temperature of freezing point
00056 !
00057 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)
00058 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)
00059 !
00060 !*      0.2    declarations of local variables
00061 !
00062 INTEGER, DIMENSION(KI)           :: IMASK
00063 INTEGER                          :: JJ, ISIZE
00064 !
00065 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00066 !
00067 !-------------------------------------------------------------------------------------
00068 ! Preliminaries:
00069 !-------------------------------------------------------------------------------------
00070 !
00071 IF (LHOOK) CALL DR_HOOK('COUPLING_ICEFLUX_N',0,ZHOOK_HANDLE)
00072 PSFTH(:)=0.0
00073 PSFTQ(:)=0.0
00074 !
00075 IMASK(:)=0
00076 ISIZE   =0
00077 DO JJ=1,KI
00078    IF(PTWAT(JJ)<PTT+10.)THEN
00079      ISIZE=ISIZE+1
00080      IMASK(ISIZE)=JJ
00081    ENDIF
00082 ENDDO
00083 !
00084 IF(ISIZE==0)THEN
00085   IF (LHOOK) CALL DR_HOOK('COUPLING_ICEFLUX_N',1,ZHOOK_HANDLE)
00086   RETURN
00087 ENDIF
00088 !
00089  CALL TREAT_ICE(ISIZE,IMASK)
00090 !
00091 !=======================================================================================
00092 !
00093 IF (LHOOK) CALL DR_HOOK('COUPLING_ICEFLUX_N',1,ZHOOK_HANDLE)
00094 CONTAINS
00095 !
00096 !=======================================================================================
00097 SUBROUTINE TREAT_ICE(KSIZE,KMASK)
00098 !
00099 IMPLICIT NONE
00100 !
00101 INTEGER, INTENT(IN) :: KSIZE
00102 INTEGER, INTENT(IN), DIMENSION(:) :: KMASK
00103 !
00104 REAL, DIMENSION(KSIZE)  :: ZTA       ! air temperature forcing               (K)
00105 REAL, DIMENSION(KSIZE)  :: ZEXNA     ! Exner function at atm. level
00106 REAL, DIMENSION(KSIZE)  :: ZRHOA     ! air density                           (kg/m3)
00107 REAL, DIMENSION(KSIZE)  :: ZTICE     ! Ice Surface Temperature
00108 REAL, DIMENSION(KSIZE)  :: ZEXNS     ! Exner function at sea surface
00109 REAL, DIMENSION(KSIZE)  :: ZQA       ! air humidity forcing                  (kg/m3)
00110 REAL, DIMENSION(KSIZE)  :: ZRR       ! liquid precipitation                  (kg/m2/s)
00111 REAL, DIMENSION(KSIZE)  :: ZRS       ! snow precipitation                    (kg/m2/s)
00112 REAL, DIMENSION(KSIZE)  :: ZWIND     ! module of wind at atm. wind level
00113 REAL, DIMENSION(KSIZE)  :: ZZREF     ! atm. level for temp. and humidity
00114 REAL, DIMENSION(KSIZE)  :: ZUREF     ! atm. level for wind
00115 REAL, DIMENSION(KSIZE)  :: ZPS       ! pressure at atmospheric model surface (Pa)
00116 REAL, DIMENSION(KSIZE)  :: ZSFTH     ! flux of heat                          (W/m2)
00117 REAL, DIMENSION(KSIZE)  :: ZSFTQ     ! flux of water vapor                   (kg/m2/s)
00118 
00119 !        
00120 REAL, DIMENSION(KSIZE)  :: ZZ0        ! roughness length over the sea ice
00121 REAL, DIMENSION(KSIZE)  :: ZQSAT      ! humidity at saturation
00122 REAL, DIMENSION(KSIZE)  :: ZUSTAR     ! friction velocity (m/s)
00123 REAL, DIMENSION(KSIZE)  :: ZCD        ! Drag coefficient
00124 REAL, DIMENSION(KSIZE)  :: ZCDN       ! Neutral Drag coefficient
00125 REAL, DIMENSION(KSIZE)  :: ZCH        ! Heat transfer coefficient
00126 REAL, DIMENSION(KSIZE)  :: ZRI        ! Richardson number
00127 REAL, DIMENSION(KSIZE)  :: ZRESA      ! aerodynamical resistance
00128 REAL, DIMENSION(KSIZE)  :: ZZ0H       ! heat roughness length over ice
00129 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00130 !
00131 IF (LHOOK) CALL DR_HOOK('COUPLING_ICEFLUX_N:TREAT_ICE',0,ZHOOK_HANDLE)
00132 !
00133 !-------------------------------------------------------------------------------------
00134 !
00135 DO JJ=1, SIZE(ZTA)
00136    ZTA  (JJ) = PTA  (KMASK(JJ))
00137    ZEXNA(JJ) = PEXNA(KMASK(JJ))
00138    ZRHOA(JJ) = PRHOA(KMASK(JJ))
00139    ZTICE(JJ) = PTICE(KMASK(JJ))
00140    ZEXNS(JJ) = PEXNS(KMASK(JJ))
00141    ZQA  (JJ) = PQA  (KMASK(JJ))
00142    ZRR  (JJ) = PRAIN(KMASK(JJ))
00143    ZRS  (JJ) = PSNOW(KMASK(JJ))
00144    ZWIND(JJ) = PWIND(KMASK(JJ))
00145    ZZREF(JJ) = PZREF(KMASK(JJ))
00146    ZUREF(JJ) = PUREF(KMASK(JJ))
00147    ZPS  (JJ) = PPS  (KMASK(JJ))
00148 END DO
00149 !
00150 ! Local variables :
00151 !
00152 ZZ0   (:) = XUNDEF
00153 ZQSAT (:) = XUNDEF
00154 ZUSTAR(:) = XUNDEF
00155 ZCD   (:) = XUNDEF    
00156 ZCDN  (:) = XUNDEF
00157 ZCH   (:) = XUNDEF
00158 ZRI   (:) = XUNDEF
00159 ZRESA (:) = XUNDEF
00160 ZZ0H  (:) = XUNDEF
00161 ZSFTH (:) = XUNDEF
00162 ZSFTQ (:) = XUNDEF
00163 !
00164 !-------------------------------------------------------------------------------------
00165 ! Fluxes over ice according to Charnock formulae
00166 !--------------------------------------------------------------------------------------
00167 !
00168  CALL ICE_SEA_FLUX(ZZ0, ZTA, ZEXNA, ZRHOA, ZTICE, ZEXNS,       &
00169                     ZQA, ZRR, ZRS, ZWIND, ZZREF, ZUREF, ZPS,  &
00170                     ZQSAT, ZSFTH, ZSFTQ, ZUSTAR, ZCD, ZCDN,   &
00171                     ZCH, ZRI, ZRESA, ZZ0H                     )  
00172 !                
00173 !-------------------------------------------------------------------------------------
00174 ! Outputs:
00175 !-------------------------------------------------------------------------------------
00176 !
00177 DO JJ=1, SIZE(ZSFTH)
00178    PSFTH(KMASK(JJ)) = ZSFTH(JJ)
00179    PSFTQ(KMASK(JJ)) = ZSFTQ(JJ)
00180 END DO
00181 !
00182 IF (LHOOK) CALL DR_HOOK('COUPLING_ICEFLUX_N:TREAT_ICE',1,ZHOOK_HANDLE)
00183 !
00184 END SUBROUTINE TREAT_ICE
00185 !
00186 !==========================================================================================
00187 !
00188 END SUBROUTINE COUPLING_ICEFLUX_n