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

Go to the documentation of this file.
00001 !     ###############################################################################
00002 SUBROUTINE ASSIM_TEB_n(YPROGRAM,KI,PT2M_O,HTEST)
00003 
00004 !     ###############################################################################
00005 !
00006 !!****  *ASSIM_TOWN_n * - Chooses the surface schemes for TOWN parts  
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    REFERENCE
00015 !!    ---------
00016 !!      
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!     T. Aspelien
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original    04/2012
00025 !!--------------------------------------------------------------------
00026 !
00027 USE MODD_CSTS,          ONLY : XPI
00028 USE MODD_SURF_PAR,      ONLY : XUNDEF
00029 USE MODD_SURF_ATM_n,    ONLY : CTOWN
00030 USE MODN_IO_OFFLINE,    ONLY : CPREPFILE
00031 !
00032 #ifdef LFI
00033 USE MODD_IO_SURF_LFI,   ONLY : CFILEIN_LFI, CFILE_LFI,CFILEOUT_LFI
00034 #endif
00035 !
00036 USE YOMHOOK,            ONLY : LHOOK,   DR_HOOK
00037 USE PARKIND1,           ONLY : JPRB
00038 !
00039 USE MODI_ABOR1_SFX
00040 USE MODI_INIT_IO_SURF_n
00041 USE MODI_READ_SURF
00042 USE MODI_END_IO_SURF_n
00043 USE MODI_IO_BUFF_CLEAN_n
00044 USE MODI_FLAG_UPDATE
00045 USE MODI_WRITE_SURF
00046 !
00047 IMPLICIT NONE
00048 !
00049 !*      0.1    declarations of arguments
00050 !
00051  CHARACTER(LEN=6),   INTENT(IN) :: YPROGRAM  ! program calling surf. schemes
00052 INTEGER,            INTENT(IN) :: KI
00053 REAL,DIMENSION(KI), INTENT(IN) :: PT2M_O
00054  CHARACTER(LEN=2),   INTENT(IN) :: HTEST ! must be equal to 'OK'
00055 !
00056 !*      0.2    declarations of local variables
00057 !
00058 !-------------------------------------------------------------------------------------
00059 !
00060 REAL, DIMENSION (KI) :: ZTRD3
00061 REAL, DIMENSION (KI) :: ZT2INC
00062 REAL, DIMENSION (KI) :: ZTCLS
00063  CHARACTER(LEN=10)    :: YVAR    ! Name of the prognostic variable (in LFI file)
00064  CHARACTER(LEN=100)   :: YPREFIX ! Prefix of the prognostic variable  (in LFI file)
00065  CHARACTER(LEN=3)     :: YREAD
00066 INTEGER              :: IRESP
00067 INTEGER              :: IVERSION, IBUGFIX
00068 REAL(KIND=JPRB)      :: ZHOOK_HANDLE
00069 !
00070 IF (LHOOK) CALL DR_HOOK('ASSIM_TEB_N',0,ZHOOK_HANDLE)
00071 
00072 IF (HTEST/='OK') THEN
00073   CALL ABOR1_SFX('ASSIM_TEB_n: FATAL ERROR DURING ARGUMENT TRANSFER')
00074 END IF
00075 
00076 WRITE(*,*) 'UPDATING TOWN FOR SCHEME: ',TRIM(CTOWN)
00077 
00078 !
00079 !------------------------------------------------------------
00080 ! READ PREP FILE
00081 !------------------------------------------------------------
00082 !
00083 !   File handling definition
00084 !
00085 #ifdef LFI
00086 CFILEIN_LFI = CPREPFILE        ! input PREP file (surface fields)
00087 CFILE_LFI=CFILEIN_LFI
00088 #endif
00089 !
00090 !   Read grid dimension for allocation
00091 !
00092  CALL INIT_IO_SURF_n(YPROGRAM,'TOWN  ','SURF  ','READ ')
00093 !
00094  CALL READ_SURF(YPROGRAM,'VERSION',IVERSION,IRESP)
00095  CALL READ_SURF(YPROGRAM,'BUG',IBUGFIX,IRESP)
00096 !
00097 !  Read prognostic variables
00098 !
00099 IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
00100   CALL READ_SURF(YPROGRAM,'T_ROAD3',   ZTRD3,  IRESP)
00101 ELSE
00102   CALL READ_SURF(YPROGRAM,'TROAD3',   ZTRD3,  IRESP)
00103 ENDIF
00104  CALL READ_SURF(YPROGRAM,'STORAGETYPE',YREAD,  IRESP)
00105 IF (YREAD=='ALL')THEN
00106  CALL READ_SURF(YPROGRAM,'T2M',       ZTCLS, IRESP)
00107 ENDIF
00108 !
00109  CALL END_IO_SURF_n(YPROGRAM)
00110  CALL IO_BUFF_CLEAN_n
00111 
00112 !
00113 ! Screen-level innovations
00114 !
00115 ZT2INC(:) = PT2M_O(:) - ZTCLS(:)
00116 
00117 PRINT *,'Mean T2m increments over TOWN ',SUM(ZT2INC)/KI
00118 
00119 !
00120 ! c) Temperature analysis of TOWN points
00121 !
00122 WHERE (ZTRD3(:)/=XUNDEF)
00123   ZTRD3(:) = ZTRD3(:) + ZT2INC(:)/(2.0*XPI)
00124 END WHERE
00125 !
00126 
00127 WRITE(*,*) 'Mean TROAD3 increments over TOWN ',SUM(ZT2INC)/KI
00128 
00129 #ifdef LFI
00130 CFILEOUT_LFI=CPREPFILE
00131 #endif
00132  CALL FLAG_UPDATE(.FALSE.,.TRUE.,.FALSE.,.FALSE.)
00133  CALL INIT_IO_SURF_n(YPROGRAM,'TOWN  ','SURF  ','WRITE')
00134 
00135 YVAR='TROAD3'
00136 YPREFIX='X_Y_T_ROAD3 (K)                                   '
00137  CALL WRITE_SURF(YPROGRAM,YVAR,ZTRD3,IRESP,HCOMMENT=YPREFIX)
00138 
00139  CALL END_IO_SURF_n(YPROGRAM)
00140  CALL IO_BUFF_CLEAN_n
00141 
00142 IF (LHOOK) CALL DR_HOOK('ASSIM_TEB_N',1,ZHOOK_HANDLE)
00143 !
00144 !-------------------------------------------------------------------------------------
00145 !
00146 END SUBROUTINE ASSIM_TEB_n