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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GET_SURF_VAR_n(HPROGRAM, KI, KS,                              &
00003                                   PSEA, PWATER, PNATURE, PTOWN,                &
00004                                   PT2M, PQ2M, PQS, PZ0, PZ0H, PZ0EFF,          &
00005                                   PZ0_SEA, PZ0_WATER, PZ0_NATURE, PZ0_TOWN,    &
00006                                   PZ0H_SEA, PZ0H_WATER, PZ0H_NATURE, PZ0H_TOWN,&
00007                                   PQS_SEA, PQS_WATER, PQS_NATURE, PQS_TOWN,    &
00008                                   PPSNG, PPSNV, PZS, PSERIES, PTWSNOW,         &
00009                                   PSSO_STDEV                     )  
00010 !     #######################################################################
00011 !
00012 !!****  *GET_SURF_VAR_n* - gets some surface fields on atmospheric grid
00013 !!
00014 !!    PURPOSE
00015 !!    -------
00016 !!
00017 !!    This program returns some surface variables neede by the atmosphere
00018 !!
00019 !!**  METHOD
00020 !!    ------
00021 !!
00022 !!    Several functions are called in order to initialize surface variables
00023 !!    needed by the atmospheric model. These functions fill the required arrays by
00024 !!    the diagnosed values computed during the run. Since all arrays are optional,
00025 !!    this program may be called with any of the arguments described above.
00026 !!
00027 !!    EXTERNAL
00028 !!    --------
00029 !!
00030 !!    IMPLICIT ARGUMENTS
00031 !!    ------------------
00032 !!
00033 !!    REFERENCE
00034 !!    ---------
00035 !!
00036 !!    AUTHOR
00037 !!    ------
00038 !!      P. Le Moigne   *Meteo France*   
00039 !!
00040 !!    MODIFICATIONS
00041 !!    -------------
00042 !!      Original    02/2006
00043 !       S. Riette   06/2010 PSSO_STDEV and PTWSNOW added
00044 !       B. Decharme 09/2012 Argument added in GET_FLUX_n
00045 !-------------------------------------------------------------------------------
00046 !
00047 !*       0.    DECLARATIONS
00048 !              ------------
00049 !
00050 USE MODD_SURF_PAR,     ONLY : XUNDEF
00051 USE MODD_SURF_ATM_n,   ONLY : CWATER
00052 USE MODI_GET_LUOUT
00053 USE MODI_GET_FLUX_n
00054 USE MODI_GET_FRAC_n
00055 USE MODI_GET_Z0_n
00056 USE MODI_GET_QS_n
00057 USE MODI_GET_VAR_SEA_n
00058 USE MODI_GET_VAR_WATER_n
00059 USE MODI_GET_VAR_NATURE_n
00060 USE MODI_GET_VAR_TOWN_n
00061 USE MODI_GET_ZS_n
00062 USE MODI_GET_SERIES_n
00063 !
00064 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00065 USE PARKIND1  ,ONLY : JPRB
00066 !
00067 USE MODI_ABOR1_SFX
00068 USE MODI_GET_SSO_STDEV_n
00069 USE MODI_GET_1D_MASK
00070 !
00071 IMPLICIT NONE
00072 !
00073 !*       0.1   Declarations of arguments
00074 !              -------------------------
00075 !
00076  CHARACTER(LEN=6),   INTENT(IN)            :: HPROGRAM    
00077 INTEGER,            INTENT(IN)            :: KI         ! number of points
00078 INTEGER,            INTENT(IN)            :: KS         ! number of points
00079 !
00080 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PSEA       ! sea fraction
00081 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PWATER     ! water fraction
00082 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PNATURE    ! nature fraction
00083 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PTOWN      ! town fraction
00084 !
00085 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PT2M       ! Air temperature at 2 meters         (K)
00086 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQ2M       ! Air humidity at 2 meters            (kg/kg)
00087 !
00088 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQS
00089 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0        ! surface roughness length            (m)
00090 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0H       ! surface roughness length for heat   (m)
00091 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0EFF     ! effective roughness length for heat (m)
00092 !
00093 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0_SEA    ! surface roughness length over sea   (m)
00094 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0_WATER  ! surface roughness length over water (m)
00095 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0_NATURE ! surface roughness length over nature(m)
00096 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0_TOWN   ! surface roughness length over town  (m)
00097 !
00098 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0H_SEA    ! surface roughness length for heat over sea   (m)
00099 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0H_WATER  ! surface roughness length for heat over water (m)
00100 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0H_NATURE ! surface roughness length for heat over nature(m)
00101 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0H_TOWN   ! surface roughness length for heat over town  (m)
00102 !
00103 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQS_SEA    ! surface humidity over sea           (kg/kg)
00104 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQS_WATER  ! surface humidity over water         (kg/kg)
00105 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQS_NATURE ! surface humidity over nature        (kg/kg)
00106 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQS_TOWN   ! surface humidity over town          (kg/kg)
00107 !
00108 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PPSNG      ! snow fraction over ground           (-)        
00109 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PPSNV      ! snow fraction over vegetation       (-)
00110 !
00111 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZS        ! surface orography                   (m)    
00112 !
00113 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PSERIES   ! any surface field for which 
00114 !                                                        ! mesoNH series are required
00115 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PTWSNOW    ! Snow total reservoir
00116 REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PSSO_STDEV ! S.S.O. standard deviation           (m)
00117 !
00118 !-------------------------------------------------------------------------------
00119 !
00120 !
00121 !*       0.2   Declarations of local variables
00122 !              -------------------------------
00123 !
00124 REAL, DIMENSION(KI)    :: ZFIELD1, ZFIELD2, ZFIELD3, ZFIELD4, ZFIELD5, ZFIELD6
00125 REAL, DIMENSION(KI)    :: ZFIELD7
00126 REAL, DIMENSION(KI,KS) :: ZSERIES
00127 INTEGER, DIMENSION(KI) :: IMASK
00128 !
00129 INTEGER :: KI_SEA    ! dimension of sea tile
00130 INTEGER :: KI_WATER  ! dimension of water tile
00131 INTEGER :: KI_NATURE ! dimension of nature tile
00132 INTEGER :: KI_TOWN   ! dimension of town tile
00133 !
00134 INTEGER                            :: JI           ! loop index over tiles
00135 INTEGER                            :: ILUOUT       ! unit number
00136 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00137 !
00138 !-------------------------------------------------------------------------------
00139 !
00140 !*   0. Logical unit for writing out
00141 !
00142 IF (LHOOK) CALL DR_HOOK('GET_SURF_VAR_N',0,ZHOOK_HANDLE)
00143  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00144 !
00145 !*   1. Fraction of each tile
00146 !
00147 IF (PRESENT(PSEA) .OR. PRESENT(PWATER) .OR. PRESENT(PNATURE) .OR. PRESENT(PTOWN)) THEN
00148    !
00149    CALL GET_FRAC_n(HPROGRAM, KI, ZFIELD1, ZFIELD2, ZFIELD3, ZFIELD4)
00150    !
00151    IF (PRESENT(PSEA)   ) PSEA    = ZFIELD1
00152    IF (PRESENT(PWATER) ) PWATER  = ZFIELD2
00153    IF (PRESENT(PNATURE)) PNATURE = ZFIELD3
00154    IF (PRESENT(PTOWN)  ) PTOWN   = ZFIELD4
00155    !
00156 END IF
00157 !
00158 !-------------------------------------------------------------------------------
00159 !
00160 !*   2. Parameters at 2 meters
00161 !
00162 IF ( PRESENT(PT2M) .OR. PRESENT(PQ2M) ) THEN
00163    !
00164    CALL GET_FLUX_n(HPROGRAM, KI, ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD2, &
00165                                  ZFIELD3, ZFIELD4, ZFIELD4, ZFIELD4, ZFIELD4, ZFIELD4  )
00166    !
00167    IF (PRESENT(PT2M)   ) PT2M    = ZFIELD2
00168    IF (PRESENT(PQ2M)   ) PQ2M    = ZFIELD3
00169    !
00170 END IF
00171 !
00172 !-------------------------------------------------------------------------------
00173 !
00174 !*   3. Roughness lengths
00175 !
00176 IF ( PRESENT(PZ0) .OR. PRESENT(PZ0H) ) THEN
00177    !
00178    CALL GET_Z0_n(HPROGRAM, KI, ZFIELD1, ZFIELD2)
00179    !
00180    IF (PRESENT(PZ0)    ) PZ0    = ZFIELD1
00181    IF (PRESENT(PZ0H)   ) PZ0H   = ZFIELD2
00182    !
00183 END IF
00184 !
00185 !-------------------------------------------------------------------------------
00186 !
00187 !*   3. Specific humidity
00188 !
00189 IF ( PRESENT(PQS) ) THEN
00190    !
00191    CALL GET_QS_n(HPROGRAM, KI, PQS)
00192    !
00193 END IF
00194 !
00195 !-------------------------------------------------------------------------------
00196 !
00197 !*   4. Surface humidity for each tile (qs is not aggregated)
00198 !
00199 IF ( PRESENT(PQS_SEA) .OR. PRESENT(PZ0_SEA) .OR. PRESENT(PZ0H_SEA) ) THEN
00200    !
00201    ! Get parameters over sea tile
00202    !
00203    IF ( .NOT.PRESENT(PSEA) ) THEN
00204       !
00205       CALL ABOR1_SFX('GET_SURF_VARN: ARGUMENT PSEA MISSING')
00206       !
00207    ENDIF
00208    !
00209    KI_SEA  = COUNT(PSEA    (:) > 0.0)
00210    !
00211    IMASK(:)=0
00212    CALL GET_1D_MASK(KI_SEA, KI, PSEA, IMASK(1:KI_SEA))
00213    !
00214    CALL GET_VAR_SEA_n(HPROGRAM, KI_SEA, ZFIELD1(1:KI_SEA), ZFIELD2(1:KI_SEA), ZFIELD3(1:KI_SEA))
00215    !
00216    IF(PRESENT(PQS_SEA))THEN
00217       PQS_SEA    (:) = XUNDEF
00218       DO JI = 1, KI_SEA
00219          PQS_SEA(IMASK(JI))  = ZFIELD1(JI)
00220       END DO
00221    ENDIF
00222    !   
00223    IF(PRESENT(PZ0_SEA))THEN
00224       PZ0_SEA    (:) = XUNDEF
00225       DO JI = 1, KI_SEA
00226          PZ0_SEA(IMASK(JI))  = ZFIELD2(JI)
00227       END DO
00228    ENDIF
00229    !
00230    IF(PRESENT(PZ0H_SEA))THEN
00231       PZ0H_SEA   (:) = XUNDEF
00232       DO JI = 1, KI_SEA
00233          PZ0H_SEA(IMASK(JI)) = ZFIELD3(JI)
00234       END DO
00235    ENDIF
00236    !
00237 ENDIF
00238    !
00239    !-------------------------------------------------------------------------------
00240    !
00241 IF ( PRESENT(PQS_WATER) .OR. PRESENT(PZ0_WATER) .OR. PRESENT(PZ0H_WATER) ) THEN
00242    !
00243    ! Get parameters over water tile
00244    !
00245    IF ( .NOT.PRESENT(PWATER) ) THEN
00246       CALL ABOR1_SFX('GET_SURF_VARN: ARGUMENT PWATER MISSING')
00247    ENDIF
00248    !
00249    KI_WATER  = COUNT(PWATER  (:) > 0.0)
00250    !
00251    IMASK(:)=0
00252    CALL GET_1D_MASK(KI_WATER, KI, PWATER, IMASK(1:KI_WATER))
00253    !
00254    CALL GET_VAR_WATER_n(HPROGRAM, KI_WATER, CWATER, ZFIELD1(1:KI_WATER), &
00255                                ZFIELD2(1:KI_WATER), ZFIELD3(1:KI_WATER))
00256    !
00257    IF(PRESENT(PQS_WATER))THEN
00258       PQS_WATER    (:) = XUNDEF
00259       DO JI = 1, KI_WATER
00260          PQS_WATER(IMASK(JI))  = ZFIELD1(JI)
00261       END DO
00262    ENDIF
00263    !   
00264    IF(PRESENT(PZ0_WATER))THEN
00265       PZ0_WATER    (:) = XUNDEF
00266       DO JI = 1, KI_WATER
00267          PZ0_WATER(IMASK(JI))  = ZFIELD2(JI)
00268       END DO
00269    ENDIF
00270    !
00271    IF(PRESENT(PZ0H_WATER))THEN
00272       PZ0H_WATER   (:) = XUNDEF
00273       DO JI = 1, KI_WATER
00274          PZ0H_WATER(IMASK(JI)) = ZFIELD3(JI)
00275       END DO
00276    ENDIF
00277    !
00278 ENDIF
00279    !
00280    !-------------------------------------------------------------------------------
00281    !
00282 IF ( PRESENT(PQS_NATURE) .OR. PRESENT(PPSNG) .OR. PRESENT(PPSNV) .OR.  PRESENT(PZ0EFF).OR. &
00283      PRESENT(PTWSNOW) ) THEN
00284    !
00285    ! Get parameters over nature tile
00286    !
00287    !
00288    IF ( .NOT.PRESENT(PNATURE) ) THEN
00289       !
00290       CALL ABOR1_SFX('GET_SURF_VARN: ARGUMENT PNATURE MISSING')
00291       !
00292    ENDIF
00293    !   
00294    KI_NATURE = COUNT(PNATURE (:) > 0.0)
00295    !
00296    IMASK(:)=0
00297    CALL GET_1D_MASK(KI_NATURE, KI, PNATURE, IMASK(1:KI_NATURE))
00298    !
00299    CALL GET_VAR_NATURE_n(HPROGRAM, KI_NATURE, ZFIELD1(1:KI_NATURE), ZFIELD2(1:KI_NATURE), &
00300                                               ZFIELD3(1:KI_NATURE), ZFIELD4(1:KI_NATURE), &
00301                         ZFIELD5(1:KI_NATURE), ZFIELD6(1:KI_NATURE), ZFIELD7(1:KI_NATURE))
00302    !
00303    IF(PRESENT(PQS_NATURE))THEN
00304      PQS_NATURE    (:) = XUNDEF
00305      DO JI = 1, KI_NATURE
00306        PQS_NATURE(IMASK(JI))  = ZFIELD1(JI)
00307      END DO
00308    ENDIF
00309    !   
00310    IF(PRESENT(PZ0_NATURE))THEN
00311      PZ0_NATURE    (:) = XUNDEF
00312      DO JI = 1, KI_NATURE
00313        PZ0_NATURE(IMASK(JI))  = ZFIELD5(JI)
00314      END DO
00315    ENDIF
00316    !
00317    IF(PRESENT(PZ0H_NATURE))THEN
00318      PZ0H_NATURE   (:) = XUNDEF
00319      DO JI = 1, KI_NATURE
00320        PZ0H_NATURE(IMASK(JI)) = ZFIELD6(JI)
00321      END DO
00322    ENDIF
00323    !  
00324    IF (PRESENT(PPSNG)) THEN
00325      PPSNG      (:) = XUNDEF
00326      DO JI = 1, KI_NATURE
00327        PPSNG     (IMASK(JI)) = ZFIELD2(JI)
00328      END DO
00329    ENDIF
00330    !
00331    IF (PRESENT(PPSNV)) THEN
00332      PPSNV      (:) = XUNDEF
00333      DO JI = 1, KI_NATURE
00334        PPSNV     (IMASK(JI)) = ZFIELD3(JI)
00335      END DO
00336    ENDIF
00337    !
00338    IF ( PRESENT(PZ0EFF) ) THEN
00339      PZ0EFF     (:) = XUNDEF
00340      DO JI = 1, KI_NATURE
00341        PZ0EFF    (IMASK(JI)) = ZFIELD4(JI)
00342      END DO
00343    ENDIF
00344    !
00345    IF(PRESENT(PTWSNOW)) THEN
00346      PTWSNOW    (:) = XUNDEF
00347      DO JI = 1, KI_NATURE
00348        PTWSNOW   (IMASK(JI)) = ZFIELD7(JI)
00349      ENDDO
00350    ENDIF
00351    !
00352 ENDIF
00353    !
00354    !-------------------------------------------------------------------------------
00355    !
00356 IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) ) THEN
00357    !
00358    ! Get parameters over town tile
00359    !
00360    IF ( .NOT.PRESENT(PTOWN) ) THEN
00361       !
00362       CALL ABOR1_SFX('GET_SURF_VARN: ARGUMENT PTOWN MISSING')
00363       !
00364    ENDIF
00365    !
00366    KI_TOWN   = COUNT(PTOWN   (:) > 0.0)
00367    !
00368    IMASK(:)=0
00369    CALL GET_1D_MASK(KI_TOWN, KI, PTOWN, IMASK(1:KI_TOWN))
00370    !
00371    CALL GET_VAR_TOWN_n(HPROGRAM, KI_TOWN, ZFIELD1(1:KI_TOWN), ZFIELD2(1:KI_TOWN), ZFIELD3(1:KI_TOWN))
00372    !
00373    IF(PRESENT(PQS_TOWN))THEN
00374       PQS_TOWN    (:) = XUNDEF
00375       DO JI = 1, KI_TOWN
00376          PQS_TOWN(IMASK(JI))  = ZFIELD1(JI)
00377       END DO
00378    ENDIF
00379    !   
00380    IF(PRESENT(PZ0_TOWN))THEN
00381       PZ0_TOWN    (:) = XUNDEF
00382       DO JI = 1, KI_TOWN
00383          PZ0_TOWN(IMASK(JI))  = ZFIELD2(JI)
00384       END DO
00385    ENDIF
00386    !
00387    IF(PRESENT(PZ0H_TOWN))THEN
00388       PZ0H_TOWN   (:) = XUNDEF
00389       DO JI = 1, KI_TOWN
00390          PZ0H_TOWN(IMASK(JI)) = ZFIELD3(JI)
00391       END DO
00392    ENDIF
00393    !
00394 END IF
00395 !
00396 !*   5. Orography
00397 !
00398 IF (PRESENT(PZS)) THEN
00399    !
00400    CALL GET_ZS_n(HPROGRAM, KI, ZFIELD1)
00401    !
00402    PZS = ZFIELD1 
00403    !
00404 END IF
00405 !
00406 !*   6. Series
00407 !
00408 IF (PRESENT(PSERIES)) THEN
00409    !
00410    IF ( .NOT.PRESENT(PWATER) ) THEN
00411       CALL ABOR1_SFX('GET_SURF_VARN: ARGUMENT PWATER REQUIRED FOR WATER SERIES')
00412    ENDIF        
00413    !
00414    IF ( COUNT(PWATER  (:) > 0.0) > 0.0 ) THEN
00415      !   
00416      CALL GET_SERIES_n(HPROGRAM, KI, KS, ZSERIES)
00417      !
00418      PSERIES = ZSERIES
00419      !
00420    ELSE
00421      PSERIES = XUNDEF
00422    ENDIF
00423    !
00424 END IF
00425 !
00426 !*   6. SSO STDEV
00427 !
00428 IF (PRESENT(PSSO_STDEV)) THEN
00429    !
00430    CALL GET_SSO_STDEV_n('ASCII ', KI, ZFIELD1)
00431    !
00432    PSSO_STDEV = ZFIELD1
00433    !
00434 END IF
00435 !
00436 IF (LHOOK) CALL DR_HOOK('GET_SURF_VAR_N',1,ZHOOK_HANDLE)
00437 !
00438 !
00439 !==============================================================================
00440 !
00441 END SUBROUTINE GET_SURF_VAR_n