SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/assim

Go to the documentation of this file.
00001 !     ###############################################################################
00002 SUBROUTINE ASSIM_ISBA_n(HPROGRAM,KI,                                   &
00003                         PCON_RAIN, PSTRAT_RAIN, PCON_SNOW, PSTRAT_SNOW,&
00004                         PCLOUDS,   PLSM,        PEVAPTR,   PEVAP,      &
00005                         PSWEC,     PTSC,                               &
00006                         PTS,       PT2M,        PHU2M,     PSWE,       &
00007                         HTEST )
00008 
00009 !     ###############################################################################
00010 !
00011 !!****  *ASSIM_ISBA_n * - Chooses the surface assimilation schemes for ISBA
00012 !!
00013 !!    PURPOSE
00014 !!    -------
00015 !!
00016 !!**  METHOD
00017 !!    ------
00018 !!
00019 !!    REFERENCE
00020 !!    ---------
00021 !!      
00022 !!
00023 !!    AUTHOR
00024 !!    ------
00025 !!     T. Aspelien
00026 !!
00027 !!    MODIFICATIONS
00028 !!    -------------
00029 !!      Original    04/2012
00030 !!--------------------------------------------------------------------
00031 !
00032 USE MODD_ASSIM,          ONLY : CASSIM_ISBA,LAESNM,LEXTRAP_NATURE,LPRINT
00033 USE MODD_SURF_ATM_n,     ONLY : NR_NATURE
00034 USE MODD_SURF_ATM_GRID_n,ONLY : XLAT, XLON
00035 USE MODN_IO_OFFLINE,     ONLY : CPGDFILE,CPREPFILE
00036 USE MODD_SURF_PAR,       ONLY : XUNDEF
00037 
00038 !
00039 #ifdef LFI
00040 USE MODD_IO_SURF_LFI,    ONLY : CFILEIN_LFI,CFILE_LFI,CFILEOUT_LFI
00041 #endif
00042 !
00043 USE YOMHOOK,             ONLY : LHOOK,   DR_HOOK
00044 USE PARKIND1,            ONLY : JPRB
00045 !
00046 USE MODI_ABOR1_SFX
00047 USE MODI_INIT_IO_SURF_n
00048 USE MODI_READ_SURF
00049 USE MODI_END_IO_SURF_n
00050 USE MODI_IO_BUFF_CLEAN_n
00051 USE MODI_OI_HOR_EXTRAPOL_SURF
00052 USE MODI_FLAG_UPDATE
00053 USE MODI_WRITE_SURF
00054 USE MODI_ASSIM_ISBA_UPDATE_SNOW
00055 USE MODI_ASSIM_NATURE_ISBA_EKF
00056 USE MODI_ASSIM_NATURE_ISBA_OI
00057 !
00058 IMPLICIT NONE
00059 !
00060 !*      0.1    declarations of arguments
00061 !
00062  CHARACTER(LEN=6),    INTENT(IN) :: HPROGRAM  ! program calling surf. schemes
00063 INTEGER,             INTENT(IN) :: KI
00064 REAL, DIMENSION(KI), INTENT(IN) :: PCON_RAIN
00065 REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_RAIN
00066 REAL, DIMENSION(KI), INTENT(IN) :: PCON_SNOW
00067 REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_SNOW
00068 REAL, DIMENSION(KI), INTENT(IN) :: PCLOUDS
00069 REAL, DIMENSION(KI), INTENT(IN) :: PLSM
00070 REAL, DIMENSION(KI), INTENT(IN) :: PEVAPTR
00071 REAL, DIMENSION(KI), INTENT(IN) :: PEVAP
00072 REAL, DIMENSION(KI), INTENT(IN) :: PSWEC
00073 REAL, DIMENSION(KI), INTENT(IN) :: PTSC
00074 REAL, DIMENSION(KI), INTENT(IN) :: PTS
00075 REAL, DIMENSION(KI), INTENT(IN) :: PT2M
00076 REAL, DIMENSION(KI), INTENT(IN) :: PHU2M
00077 REAL, DIMENSION(KI), INTENT(IN) :: PSWE
00078  CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'
00079 !
00080 !*      0.2    declarations of local variables
00081 !
00082 !-------------------------------------------------------------------------------------
00083 !
00084 REAL(KIND=JPRB)                    :: ZHOOK_HANDLE
00085 LOGICAL, DIMENSION(:), ALLOCATABLE :: OINTERP_NATURE
00086 LOGICAL, DIMENSION(:), ALLOCATABLE :: OINTERP_SN
00087 REAL,    DIMENSION(:), ALLOCATABLE :: PLON
00088 REAL,    DIMENSION(:), ALLOCATABLE :: PLAT
00089 REAL,    DIMENSION(:), ALLOCATABLE :: PTS_EP,ZTS_EP
00090 REAL,    DIMENSION(:), ALLOCATABLE :: PTP_EP,ZTP_EP
00091 REAL,    DIMENSION(:), ALLOCATABLE :: PT3_EP,ZT3_EP
00092 REAL,    DIMENSION(:), ALLOCATABLE :: PWS_EP,ZWS_EP
00093 REAL,    DIMENSION(:), ALLOCATABLE :: PWP_EP,ZWP_EP
00094 REAL,    DIMENSION(:), ALLOCATABLE :: PTL_EP,ZTL_EP
00095 REAL,    DIMENSION(:), ALLOCATABLE :: PSWE_EP,ZSWE_EP
00096 REAL,    DIMENSION(:), ALLOCATABLE :: PSNR_EP,ZSNR_EP
00097 REAL,    DIMENSION(:), ALLOCATABLE :: PSNA_EP,ZSNA_EP
00098 REAL,    DIMENSION(:), ALLOCATABLE :: ZALT
00099 REAL,    DIMENSION(KI)     :: ZSWE
00100 REAL,    DIMENSION(KI)     :: ZSWE_ORIG
00101 INTEGER                            :: IVERSION, IBUGFIX
00102 INTEGER                            :: I,IRESP
00103  CHARACTER(LEN=10)                  :: YVAR    ! Name of the prognostic variable (in LFI file)
00104  CHARACTER(LEN=100)                 :: YPREFIX ! Prefix of the prognostic variable  (in LFI file)
00105 
00106 IF (LHOOK) CALL DR_HOOK('ASSIM_ISBA_N',0,ZHOOK_HANDLE)
00107 
00108 IF (HTEST/='OK') THEN
00109   CALL ABOR1_SFX('ASSIM_ISBA_n: FATAL ERROR DURING ARGUMENT TRANSFER')
00110 END IF
00111 
00112 ZSWE=PSWE
00113 ZSWE_ORIG=PSWE
00114 
00115 ! Soil assimilation
00116 IF ( CASSIM_ISBA == 'EKF  ' ) THEN
00117 
00118   ! Snow analysis/update
00119   IF (LAESNM) THEN
00120     WRITE(*,*) 'UPDATE SNOW FROM ANALYSED CANARI VALUES'
00121     CALL ASSIM_ISBA_UPDATE_SNOW(HPROGRAM,KI,ZSWE,ZSWE_ORIG,.TRUE.,.TRUE.,HTEST)
00122   ELSE
00123     WRITE(*,*) 'SNOW IS NOT UPDATED FROM ANALYSED CANARI VALUES'
00124   ENDIF
00125 
00126   ! Run EKF for soil
00127   CALL ASSIM_NATURE_ISBA_EKF(HPROGRAM,KI,   &
00128                              PT2M,    PHU2M,&
00129                              HTEST )
00130 
00131 ELSEIF ( CASSIM_ISBA == 'OI   ' ) THEN
00132 
00133   ! Snow analysis/update. Store the original field in the surfex file
00134   IF (LAESNM) THEN
00135     WRITE(*,*) 'UPDATE SNOW FROM ANALYSED CANARI VALUES'
00136     CALL ASSIM_ISBA_UPDATE_SNOW(HPROGRAM,KI,ZSWE,ZSWE_ORIG,.TRUE.,.FALSE.,HTEST)
00137   ELSE
00138     WRITE(*,*) 'SNOW IS NOT UPDATED FROM ANALYSED CANARI VALUES'
00139   ENDIF
00140 
00141   ! Run OI for soil
00142   CALL ASSIM_NATURE_ISBA_OI(HPROGRAM, KI,                                  &
00143                             PCON_RAIN, PSTRAT_RAIN, PCON_SNOW, PSTRAT_SNOW,&
00144                             PCLOUDS,   PLSM,        PEVAPTR,   PEVAP,      &
00145                             PSWEC,     PTSC,                               &
00146                             PTS,       PT2M,        PHU2M,     ZSWE,       &
00147                             HTEST )
00148 
00149   ! Snow analysis/update (changed in oi_cacsts). Get the full increment
00150   IF (LAESNM) THEN
00151     WRITE(*,*) 'UPDATE SNOW FROM ANALYSED OI_CACSTS VALUES'
00152     CALL ASSIM_ISBA_UPDATE_SNOW(HPROGRAM,KI,ZSWE,ZSWE_ORIG,.FALSE.,.TRUE.,HTEST)
00153   ELSE
00154     WRITE(*,*) 'SNOW IS NOT UPDATED FROM ANALYSED OI_CACSTS VALUES'
00155   ENDIF
00156 ELSE
00157   CALL ABOR1_SFX(CASSIM_ISBA//' is not a defined scheme for ASSIM_ISBA_N')
00158 ENDIF
00159 
00160 ! Extrapolation if requested
00161 IF ( LEXTRAP_NATURE ) THEN
00162   ALLOCATE(OINTERP_NATURE(KI))
00163   ALLOCATE(OINTERP_SN(KI))
00164   ALLOCATE(PLON(KI))
00165   ALLOCATE(PLAT(KI))
00166   ALLOCATE(PTS_EP(KI),ZTS_EP(KI))
00167   ALLOCATE(PTP_EP(KI),ZTP_EP(KI))
00168   ALLOCATE(PT3_EP(KI),ZT3_EP(KI))
00169   ALLOCATE(PWS_EP(KI),ZWS_EP(KI))
00170   ALLOCATE(PWP_EP(KI),ZWP_EP(KI))
00171   ALLOCATE(PTL_EP(KI),ZTL_EP(KI))
00172   ALLOCATE(PSWE_EP(KI),ZSWE_EP(KI))
00173   ALLOCATE(PSNR_EP(KI),ZSNR_EP(KI))
00174   ALLOCATE(PSNA_EP(KI),ZSNA_EP(KI))
00175   ALLOCATE(ZALT(KI))
00176 
00177   ! Set longitudes/latitudes for nature points
00178   DO I=1,KI
00179     PLON(I)=XLON(NR_NATURE(I))
00180     PLAT(I)=XLAT(NR_NATURE(I))
00181   ENDDO
00182 
00183   !   Read orography
00184 #ifdef LFI
00185   CFILEIN_LFI = CPGDFILE
00186   CFILE_LFI=CFILEIN_LFI
00187 #endif
00188   CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','SURF  ','READ ')
00189   CALL READ_SURF(HPROGRAM,'ZS',        ZALT,     IRESP)
00190   !
00191   CALL END_IO_SURF_n(HPROGRAM)
00192   CALL IO_BUFF_CLEAN_n
00193 
00194   !   Read field to extrapolate from
00195 #ifdef LFI
00196   CFILEIN_LFI = CPREPFILE
00197   CFILE_LFI=CFILEIN_LFI
00198 #endif
00199   CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','SURF  ','READ ')
00200 
00201   CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
00202   CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
00203 
00204   CALL READ_SURF(HPROGRAM,'WG1',       PWS_EP,   IRESP)
00205   CALL READ_SURF(HPROGRAM,'WG2',       PWP_EP,   IRESP)
00206   CALL READ_SURF(HPROGRAM,'TG1',       PTS_EP,   IRESP)
00207   CALL READ_SURF(HPROGRAM,'TG2',       PTP_EP,   IRESP)
00208   CALL READ_SURF(HPROGRAM,'TG3',       PT3_EP,   IRESP)
00209   CALL READ_SURF(HPROGRAM,'WGI2',      PTL_EP,   IRESP)
00210   IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00211     CALL READ_SURF(HPROGRAM,'WSNOW_VEG1',PSWE_EP,  IRESP)
00212     CALL READ_SURF(HPROGRAM,'RSNOW_VEG1',PSNR_EP,  IRESP)
00213     CALL READ_SURF(HPROGRAM,'ASNOW_VEG', PSNA_EP,  IRESP)
00214   ELSE
00215     CALL READ_SURF(HPROGRAM,'WSN_VEG1',PSWE_EP,  IRESP)
00216     CALL READ_SURF(HPROGRAM,'RSN_VEG1',PSNR_EP,  IRESP)
00217     CALL READ_SURF(HPROGRAM,'ASN_VEG', PSNA_EP,  IRESP)
00218   ENDIF          
00219   !
00220   CALL END_IO_SURF_n(HPROGRAM)
00221   CALL IO_BUFF_CLEAN_n
00222 
00223   ! Search for the nearest grid point values for land surface fields
00224   ! at locations where the CANARI land fraction is less than 50%
00225   ! and therefore useless values MIGTH be given
00226 
00227   OINTERP_NATURE = .FALSE.
00228   OINTERP_SN     = .FALSE.
00229 
00230   ! Snow albedo and density are also extrapolated in points 
00231   ! which get initial snow in the snow analysis
00232   WHERE ( PSWE_EP(:) < 1.0E-10 .AND. PSWE(:)>= 1.0E-10 )
00233     OINTERP_SN(:) = .TRUE.
00234     PSNA_EP(:)    = XUNDEF
00235     PSNR_EP(:)    = XUNDEF
00236   END WHERE
00237   PSWE_EP(:)      = PSWE(:)
00238 
00239   WHERE ( PLSM(:) < 0.5 )
00240     OINTERP_NATURE(:) = .TRUE.
00241     OINTERP_SN(:) = .TRUE.
00242     PTS_EP(:)     = XUNDEF
00243     PTP_EP(:)     = XUNDEF
00244     PT3_EP(:)     = XUNDEF
00245     PWS_EP(:)     = XUNDEF
00246     PWP_EP(:)     = XUNDEF
00247     PTL_EP(:)     = XUNDEF
00248     PSWE_EP(:)    = XUNDEF
00249     PSNA_EP(:)    = XUNDEF
00250     PSNR_EP(:)    = XUNDEF
00251   END WHERE
00252 
00253   ZTS_EP(:) = PTS_EP(:)
00254   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZTS_EP,PLAT,PLON,PTS_EP,OINTERP_NATURE,ZALT)
00255   ZTP_EP(:) = PTP_EP(:)
00256   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZTP_EP,PLAT,PLON,PTP_EP,OINTERP_NATURE,ZALT)
00257   ZT3_EP(:) = PT3_EP(:)
00258   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZT3_EP,PLAT,PLON,PT3_EP,OINTERP_NATURE,ZALT)
00259   ZWS_EP(:) = PWS_EP(:)
00260   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZWS_EP,PLAT,PLON,PWS_EP,OINTERP_NATURE)
00261   ZWP_EP(:) = PWP_EP(:)
00262   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZWP_EP,PLAT,PLON,PWP_EP,OINTERP_NATURE)
00263   ZTL_EP(:) = PTL_EP(:)
00264   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZTL_EP,PLAT,PLON,PTL_EP,OINTERP_NATURE)
00265   ZSWE_EP(:) = PSWE_EP(:)
00266   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZSWE_EP,PLAT,PLON,PSWE_EP,OINTERP_NATURE)
00267   ZSNA_EP(:) = PSNA_EP(:)
00268   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZSNA_EP,PLAT,PLON,PSNA_EP,OINTERP_SN)
00269   ZSNR_EP(:) = PSNR_EP(:)
00270   CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT,PLON,ZSNR_EP,PLAT,PLON,PSNR_EP,OINTERP_SN)
00271 
00272   ! Removes very small SWE values and set density and albedo to UNDEF
00273   WHERE ( PSWE_EP(:)/=XUNDEF .AND. PSWE_EP(:)<1.0E-10 )
00274     PSWE_EP(:) = 0.0
00275     PSNA_EP(:) = XUNDEF
00276     PSNR_EP(:) = XUNDEF
00277   END WHERE
00278 
00279   !
00280   ! PRINT values produced by OI_HO_EXTRAPOL_SURF for TS
00281   !
00282   IF (LPRINT) THEN
00283     DO I=1,KI
00284      IF (OINTERP_NATURE(I)) THEN
00285        PRINT *,'Surface temperature set to ',PTS_EP(I),'from nearest neighbour at I=',NR_NATURE(I)
00286      ENDIF
00287     ENDDO
00288   ENDIF
00289 
00290   !
00291   !   Write extrapolated fields to file
00292   !
00293 #ifdef LFI
00294   CFILEOUT_LFI=CPREPFILE
00295 #endif
00296   CALL FLAG_UPDATE(.FALSE.,.TRUE.,.FALSE.,.FALSE.)
00297   CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','SURF  ','WRITE')
00298   !
00299   YVAR='WG1'
00300   YPREFIX='X_Y_WG1 (m3/m3)                                   '
00301   CALL WRITE_SURF(HPROGRAM,YVAR,PWS_EP,IRESP,HCOMMENT=YPREFIX)
00302   YVAR='WG2'
00303   YPREFIX='X_Y_WG2 (m3/m3)                                   '
00304   CALL WRITE_SURF(HPROGRAM,YVAR,PWP_EP,IRESP,HCOMMENT=YPREFIX)
00305   YVAR='WGI2'
00306   YPREFIX='X_Y_WGI2 (m3/m3)                                  '
00307   CALL WRITE_SURF(HPROGRAM,YVAR,PTL_EP,IRESP,HCOMMENT=YPREFIX)
00308   YVAR='TG1'
00309   YPREFIX='X_Y_TG1 (K)                                       '
00310   CALL WRITE_SURF(HPROGRAM,YVAR,PTS_EP,IRESP,HCOMMENT=YPREFIX)
00311   YVAR='TG2'
00312   YPREFIX='X_Y_TG2 (K)                                       '
00313   CALL WRITE_SURF(HPROGRAM,YVAR,PTP_EP,IRESP,HCOMMENT=YPREFIX)
00314   YVAR='TG3'
00315   YPREFIX='X_Y_TG3 (K)                                       '
00316   CALL WRITE_SURF(HPROGRAM,YVAR,PT3_EP,IRESP,HCOMMENT=YPREFIX)
00317   YVAR='WSN_VEG1'
00318   YPREFIX='X_Y_WSNOW_VEG1 (kg/m2)                            '
00319   CALL WRITE_SURF(HPROGRAM,YVAR,PSWE_EP,IRESP,HCOMMENT=YPREFIX)
00320   YVAR='RSN_VEG1'
00321   YPREFIX='X_Y_RSNOW_VEG1 (kg/m3)                            '
00322   CALL WRITE_SURF(HPROGRAM,YVAR,PSNR_EP,IRESP,HCOMMENT=YPREFIX)
00323   YVAR='ASN_VEG'
00324   YPREFIX='X_Y_ASNOW_VEG1 (%)                            '
00325   CALL WRITE_SURF(HPROGRAM,YVAR,PSNA_EP,IRESP,HCOMMENT=YPREFIX)
00326 
00327   !
00328   CALL END_IO_SURF_n(HPROGRAM)
00329   CALL IO_BUFF_CLEAN_n
00330 
00331   DEALLOCATE(OINTERP_NATURE)
00332   DEALLOCATE(OINTERP_SN)
00333   DEALLOCATE(PLON)
00334   DEALLOCATE(PLAT)
00335   DEALLOCATE(PTS_EP,ZTS_EP)
00336   DEALLOCATE(PTP_EP,ZTP_EP)
00337   DEALLOCATE(PT3_EP,ZT3_EP)
00338   DEALLOCATE(PWS_EP,ZWS_EP)
00339   DEALLOCATE(PWP_EP,ZWP_EP)
00340   DEALLOCATE(PTL_EP,ZTL_EP)
00341   DEALLOCATE(PSWE_EP,ZSWE_EP)
00342   DEALLOCATE(PSNR_EP,ZSNR_EP)
00343   DEALLOCATE(PSNA_EP,ZSNA_EP)
00344   DEALLOCATE(ZALT)
00345 ENDIF
00346 
00347 IF (LHOOK) CALL DR_HOOK('ASSIM_ISBA_N',1,ZHOOK_HANDLE)
00348 !
00349 !-------------------------------------------------------------------------------------
00350 !
00351 END SUBROUTINE ASSIM_ISBA_n