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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GET_SFXCPL_n(HPROGRAM,KI,PRUI,PWIND,PFWSU,PFWSV,PSNET, &
00003                                 PHEAT,PEVAP,PRAIN,PSNOW,PICEFLUX,PFWSM,   &
00004                                 PHEAT_ICE,PEVAP_ICE,PSNET_ICE)  
00005 !     ###################################################################
00006 !
00007 !!****  *GETSFXCPL_n* - routine to get some variables from surfex into
00008 !                       ocean and/or a river routing model
00009 !!    PURPOSE
00010 !!    -------
00011 !!
00012 !!**  METHOD
00013 !!    ------
00014 !!
00015 !!    EXTERNAL
00016 !!    --------
00017 !!
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------
00021 !!
00022 !!    REFERENCE
00023 !!    ---------
00024 !!
00025 !!
00026 !!    AUTHOR
00027 !!    ------
00028 !!      B. Decharme      *Meteo France* 
00029 !!
00030 !!    MODIFICATIONS
00031 !!    -------------
00032 !!      Original    08/2009
00033 !-------------------------------------------------------------------------------
00034 !
00035 !*       0.    DECLARATIONS
00036 !              ------------
00037 !
00038 USE MODD_SURF_PAR,  ONLY : XUNDEF
00039 !
00040 USE MODD_ISBA_n,    ONLY : XCPL_DRAIN, XCPL_RUNOFF, XCPL_ICEFLUX
00041 !
00042 USE MODD_SEAFLUX_n, ONLY : XCPL_SEA_WIND,XCPL_SEA_EVAP,XCPL_SEA_HEAT, &
00043                              XCPL_SEA_SNET,XCPL_SEA_FWSU,XCPL_SEA_FWSV, &
00044                              XCPL_SEA_RAIN,XCPL_SEA_SNOW,XCPL_SEA_FWSM, &
00045                              XCPL_SEAICE_EVAP,XCPL_SEAICE_HEAT,         &
00046                              XCPL_SEAICE_SNET  
00047 !
00048 USE MODD_WATFLUX_n, ONLY : XCPL_WATER_WIND,XCPL_WATER_EVAP,XCPL_WATER_HEAT, &
00049                              XCPL_WATER_SNET,XCPL_WATER_FWSU,XCPL_WATER_FWSV, &
00050                              XCPL_WATER_RAIN,XCPL_WATER_SNOW,XCPL_WATER_FWSM, &
00051                              XCPL_WATERICE_EVAP,XCPL_WATERICE_HEAT,           &
00052                              XCPL_WATERICE_SNET  
00053 !
00054 USE MODI_UNPACK_SAME_RANK
00055 USE MODI_GET_LUOUT
00056 !
00057 !
00058 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00059 USE PARKIND1  ,ONLY : JPRB
00060 !
00061 USE MODI_GET_1D_MASK
00062 !
00063 USE MODI_GET_FRAC_n
00064 IMPLICIT NONE
00065 !
00066 !*       0.1   Declarations of arguments
00067 !              -------------------------
00068 !
00069  CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM
00070 INTEGER,             INTENT(IN)  :: KI      ! number of points
00071 !
00072 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PRUI
00073 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PWIND
00074 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PFWSU
00075 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PFWSV
00076 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PSNET
00077 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PHEAT
00078 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PEVAP
00079 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PRAIN
00080 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PSNOW
00081 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PICEFLUX
00082 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PFWSM
00083 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PHEAT_ICE
00084 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PEVAP_ICE
00085 REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: PSNET_ICE
00086 !
00087 !*       0.2   Declarations of local variables
00088 !              -------------------------------
00089 !
00090 REAL, DIMENSION(KI)  :: ZSEA    ! fraction of sea
00091 REAL, DIMENSION(KI)  :: ZWATER  ! fraction of water
00092 REAL, DIMENSION(KI)  :: ZNATURE ! fraction of nature
00093 REAL, DIMENSION(KI)  :: ZTOWN   ! fraction of town
00094 !
00095 LOGICAL :: LPRESENT1, LPRESENT2
00096 !
00097 INTEGER :: ILU, ILUOUT
00098 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00099 !
00100 !-------------------------------------------------------------------------------
00101 IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N',0,ZHOOK_HANDLE)
00102  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00103 !-------------------------------------------------------------------------------
00104 ! Global argument
00105 !
00106  CALL GET_FRAC_n(HPROGRAM, KI, ZSEA, ZWATER, ZNATURE, ZTOWN)
00107 !
00108 !-------------------------------------------------------------------------------
00109 ! Get variable over nature tile
00110 !
00111 LPRESENT1=PRESENT(PRUI)
00112 LPRESENT2=PRESENT(PICEFLUX)
00113 !
00114 IF (LPRESENT1 .OR. LPRESENT2) THEN
00115   ILU=COUNT(ZNATURE(:)>0.0)
00116   CALL TREAT_NATURE(LPRESENT1,LPRESENT2,ILU)
00117 ENDIF
00118 !
00119 !-------------------------------------------------------------------------------
00120 ! Get variable over sea and water tiles and for ice
00121 !
00122 LPRESENT1=(PRESENT(PWIND).AND.PRESENT(PFWSU).AND.PRESENT(PFWSV).AND.PRESENT(PSNET).AND. &
00123             PRESENT(PHEAT).AND.PRESENT(PEVAP).AND.PRESENT(PRAIN).AND.PRESENT(PSNOW))
00124 LPRESENT2=(PRESENT(PSNET_ICE).AND.PRESENT(PHEAT_ICE).AND.PRESENT(PEVAP_ICE))
00125 !
00126 IF (LPRESENT1 .OR. LPRESENT2) THEN
00127   ILU=COUNT(ZSEA(:)>0.0)
00128   CALL TREAT_SEA(LPRESENT1,LPRESENT2,ILU)  
00129   !
00130   ILU=COUNT(ZWATER(:)>0.0)
00131   CALL TREAT_WATER(LPRESENT1,LPRESENT2,ILU)
00132 ENDIF
00133 !
00134 !-------------------------------------------------------------------------------
00135 IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N',1,ZHOOK_HANDLE)
00136 !
00137 CONTAINS
00138 !
00139 SUBROUTINE TREAT_NATURE(OPRESENT1,OPRESENT2,KLU)
00140 !
00141 IMPLICIT NONE
00142 !
00143 LOGICAL, INTENT(IN) :: OPRESENT1
00144 LOGICAL, INTENT(IN) :: OPRESENT2
00145 INTEGER, INTENT(IN) :: KLU
00146 !
00147 INTEGER, DIMENSION(KLU) :: IMASK
00148 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00149 !
00150 IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N:TREAT_NATURE',0,ZHOOK_HANDLE)
00151 !
00152  CALL GET_1D_MASK(KLU,KI,ZNATURE,IMASK)
00153 !
00154 IF (OPRESENT1) THEN
00155   !
00156   XCPL_RUNOFF(:)=XCPL_RUNOFF(:)+XCPL_DRAIN(:)
00157   CALL UNPACK_SAME_RANK(IMASK,XCPL_RUNOFF(:),PRUI(:),XUNDEF)
00158   !
00159   XCPL_RUNOFF (:) = 0.0
00160   XCPL_DRAIN  (:) = 0.0
00161   !
00162 ENDIF
00163 !
00164 IF (OPRESENT2) THEN
00165   !
00166   CALL UNPACK_SAME_RANK(IMASK,XCPL_ICEFLUX(:),PICEFLUX(:),XUNDEF)
00167   !
00168   XCPL_ICEFLUX(:) = 0.0
00169   !
00170 ENDIF
00171 !
00172 IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N:TREAT_NATURE',1,ZHOOK_HANDLE)
00173 !
00174 END SUBROUTINE TREAT_NATURE
00175 !
00176 !
00177 SUBROUTINE TREAT_SEA(OPRESENT1,OPRESENT2,KLU)
00178 !
00179 IMPLICIT NONE
00180 !
00181 LOGICAL, INTENT(IN) :: OPRESENT1
00182 LOGICAL, INTENT(IN) :: OPRESENT2
00183 INTEGER, INTENT(IN) :: KLU
00184 !
00185 INTEGER, DIMENSION(KLU) :: IMASK
00186 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00187 !
00188 IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N:TREAT_SEA',0,ZHOOK_HANDLE)
00189 !
00190  CALL GET_1D_MASK(KLU,KI,ZSEA,IMASK)
00191 !
00192 IF (OPRESENT1) THEN
00193   !
00194   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_WIND(:),PWIND(:),XUNDEF)
00195   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_FWSU(:),PFWSU(:),XUNDEF)
00196   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_FWSV(:),PFWSV(:),XUNDEF)
00197   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_SNET(:),PSNET(:),XUNDEF)
00198   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_HEAT(:),PHEAT(:),XUNDEF)
00199   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_EVAP(:),PEVAP(:),XUNDEF)
00200   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_RAIN(:),PRAIN(:),XUNDEF)
00201   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_SNOW(:),PSNOW(:),XUNDEF)
00202   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEA_FWSM(:),PFWSM(:),XUNDEF)
00203   !
00204   XCPL_SEA_WIND(:) = 0.0
00205   XCPL_SEA_EVAP(:) = 0.0
00206   XCPL_SEA_HEAT(:) = 0.0
00207   XCPL_SEA_SNET(:) = 0.0
00208   XCPL_SEA_FWSU(:) = 0.0
00209   XCPL_SEA_FWSV(:) = 0.0
00210   XCPL_SEA_RAIN(:) = 0.0
00211   XCPL_SEA_SNOW(:) = 0.0
00212   XCPL_SEA_FWSM(:) = 0.0
00213   !
00214 ENDIF
00215 !
00216 IF (OPRESENT2) THEN
00217   !
00218   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEAICE_SNET(:),PSNET_ICE(:),XUNDEF)
00219   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEAICE_HEAT(:),PHEAT_ICE(:),XUNDEF)
00220   CALL UNPACK_SAME_RANK(IMASK,XCPL_SEAICE_EVAP(:),PEVAP_ICE(:),XUNDEF)
00221   !
00222   XCPL_SEAICE_SNET(:) = 0.0
00223   XCPL_SEAICE_EVAP(:) = 0.0
00224   XCPL_SEAICE_HEAT(:) = 0.0
00225   !  
00226 ENDIF
00227 !
00228 IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N:TREAT_SEA',1,ZHOOK_HANDLE)
00229 !
00230 END SUBROUTINE TREAT_SEA
00231 !
00232 !
00233 SUBROUTINE TREAT_WATER(OPRESENT1,OPRESENT2,KLU)
00234 !
00235 IMPLICIT NONE
00236 !
00237 LOGICAL, INTENT(IN) :: OPRESENT1
00238 LOGICAL, INTENT(IN) :: OPRESENT2
00239 INTEGER, INTENT(IN) :: KLU
00240 !
00241 INTEGER, DIMENSION(KLU) :: IMASK
00242 !
00243 REAL, DIMENSION(KI)  :: ZWIND
00244 REAL, DIMENSION(KI)  :: ZFWSU
00245 REAL, DIMENSION(KI)  :: ZFWSV
00246 REAL, DIMENSION(KI)  :: ZSNET
00247 REAL, DIMENSION(KI)  :: ZHEAT
00248 REAL, DIMENSION(KI)  :: ZEVAP
00249 REAL, DIMENSION(KI)  :: ZRAIN
00250 REAL, DIMENSION(KI)  :: ZSNOW
00251 REAL, DIMENSION(KI)  :: ZFWSM
00252 !
00253 REAL, DIMENSION(KI)  :: ZSNET_ICE
00254 REAL, DIMENSION(KI)  :: ZHEAT_ICE
00255 REAL, DIMENSION(KI)  :: ZEVAP_ICE
00256 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00257 !
00258 IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N:TREAT_WATER',0,ZHOOK_HANDLE)
00259 !
00260  CALL GET_1D_MASK(KLU,KI,ZWATER,IMASK)
00261 !
00262 IF (OPRESENT1) THEN
00263   !
00264   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_WIND(:),ZWIND(:),XUNDEF)
00265   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_FWSU(:),ZFWSU(:),XUNDEF)
00266   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_FWSV(:),ZFWSV(:),XUNDEF)
00267   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_SNET(:),ZSNET(:),XUNDEF)
00268   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_HEAT(:),ZHEAT(:),XUNDEF)
00269   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_EVAP(:),ZEVAP(:),XUNDEF)
00270   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_RAIN(:),ZRAIN(:),XUNDEF)
00271   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_SNOW(:),ZSNOW(:),XUNDEF)
00272   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATER_FWSM(:),ZFWSM(:),XUNDEF)
00273   !  
00274   WHERE(ZSEA(:)>.0.OR.ZWATER(:)>0.0) 
00275   !
00276     PWIND(:) = (ZSEA(:)*PWIND(:) + ZWATER(:)*ZWIND(:))/(ZSEA(:)+ZWATER(:))
00277     PFWSU(:) = (ZSEA(:)*PFWSU(:) + ZWATER(:)*ZFWSU(:))/(ZSEA(:)+ZWATER(:))
00278     PFWSV(:) = (ZSEA(:)*PFWSV(:) + ZWATER(:)*ZFWSV(:))/(ZSEA(:)+ZWATER(:))
00279     PSNET(:) = (ZSEA(:)*PSNET(:) + ZWATER(:)*ZSNET(:))/(ZSEA(:)+ZWATER(:))
00280     PHEAT(:) = (ZSEA(:)*PHEAT(:) + ZWATER(:)*ZHEAT(:))/(ZSEA(:)+ZWATER(:))
00281     PEVAP(:) = (ZSEA(:)*PEVAP(:) + ZWATER(:)*ZEVAP(:))/(ZSEA(:)+ZWATER(:))
00282     PRAIN(:) = (ZSEA(:)*PRAIN(:) + ZWATER(:)*ZRAIN(:))/(ZSEA(:)+ZWATER(:))
00283     PSNOW(:) = (ZSEA(:)*PSNOW(:) + ZWATER(:)*ZSNOW(:))/(ZSEA(:)+ZWATER(:))
00284     PFWSM(:) = (ZSEA(:)*PFWSM(:) + ZWATER(:)*ZFWSM(:))/(ZSEA(:)+ZWATER(:))
00285   !
00286   ENDWHERE  
00287   !
00288   XCPL_WATER_WIND(:) = 0.0
00289   XCPL_WATER_EVAP(:) = 0.0
00290   XCPL_WATER_HEAT(:) = 0.0
00291   XCPL_WATER_SNET(:) = 0.0
00292   XCPL_WATER_FWSU(:) = 0.0
00293   XCPL_WATER_FWSV(:) = 0.0
00294   XCPL_WATER_RAIN(:) = 0.0
00295   XCPL_WATER_SNOW(:) = 0.0
00296   XCPL_WATER_FWSM(:) = 0.0
00297   !
00298 ENDIF
00299 !
00300 IF (OPRESENT2) THEN
00301   !
00302   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATERICE_SNET(:),ZSNET_ICE(:),XUNDEF)
00303   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATERICE_HEAT(:),ZHEAT_ICE(:),XUNDEF)
00304   CALL UNPACK_SAME_RANK(IMASK,XCPL_WATERICE_EVAP(:),ZEVAP_ICE(:),XUNDEF)
00305   !  
00306   WHERE(ZSEA(:)>.0.OR.ZWATER(:)>0.0)     
00307     PSNET_ICE(:) = (ZSEA(:)*PSNET_ICE(:) + ZWATER(:)*ZSNET_ICE(:))/(ZSEA(:)+ZWATER(:))
00308     PHEAT_ICE(:) = (ZSEA(:)*PHEAT_ICE(:) + ZWATER(:)*ZHEAT_ICE(:))/(ZSEA(:)+ZWATER(:))
00309     PEVAP_ICE(:) = (ZSEA(:)*PEVAP_ICE(:) + ZWATER(:)*ZEVAP_ICE(:))/(ZSEA(:)+ZWATER(:))
00310   ENDWHERE
00311   !  
00312   XCPL_WATERICE_SNET(:) = 0.0
00313   XCPL_WATERICE_EVAP(:) = 0.0
00314   XCPL_WATERICE_HEAT(:) = 0.0
00315   !  
00316 ENDIF
00317 !
00318 IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N:TREAT_WATER',1,ZHOOK_HANDLE)
00319 !
00320 END SUBROUTINE TREAT_WATER
00321 !
00322 !==============================================================================
00323 !
00324 END SUBROUTINE GET_SFXCPL_n