SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE WRITE_TEB_n(HPROGRAM,HWRITE) 00003 ! #################################### 00004 ! 00005 !!**** *WRITE_TEB_n* - routine to write surface variables in their respective files 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! EXTERNAL 00014 !! -------- 00015 !! 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! 00024 !! AUTHOR 00025 !! ------ 00026 !! V. Masson *Meteo France* 00027 !! 00028 !! MODIFICATIONS 00029 !! ------------- 00030 !! Original 01/2003 00031 !! B. Decharme 07/2011 : Suppress pgd output 00032 !------------------------------------------------------------------------------- 00033 ! 00034 !* 0. DECLARATIONS 00035 ! ------------ 00036 ! 00037 USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY 00038 USE MODD_DIAG_SURF_ATM_n, ONLY: LSELECT 00039 USE MODD_TEB_n, ONLY : NTEB_PATCH 00040 ! 00041 USE MODI_INIT_IO_SURF_n 00042 USE MODI_WRITESURF_TEB_n 00043 USE MODI_WRITESURF_TEB_CONF_n 00044 USE MODI_END_IO_SURF_n 00045 USE MODI_WRITESURF_TEB_CANOPY_n 00046 USE MODI_GOTO_TEB 00047 ! 00048 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00049 USE PARKIND1 ,ONLY : JPRB 00050 ! 00051 IMPLICIT NONE 00052 ! 00053 !* 0.1 Declarations of arguments 00054 ! ------------------------- 00055 ! 00056 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00057 CHARACTER(LEN=3), INTENT(IN) :: HWRITE ! 'PREP' : does not write SBL XUNDEF fields 00058 ! ! 'ALL' : all fields are written 00059 !* 0.2 Declarations of local variables 00060 ! ------------------------------- 00061 ! 00062 INTEGER :: JPATCH 00063 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00064 !------------------------------------------------------------------------------- 00065 ! 00066 ! 00067 ! Initialisation for IO 00068 ! 00069 IF (LHOOK) CALL DR_HOOK('WRITE_TEB_N',0,ZHOOK_HANDLE) 00070 CALL INIT_IO_SURF_n(HPROGRAM,'TOWN ','TEB ','WRITE') 00071 ! 00072 !* 1. Selection of surface scheme 00073 ! --------------------------- 00074 ! 00075 CALL WRITESURF_TEB_CONF_n(HPROGRAM) 00076 ! 00077 DO JPATCH=1,NTEB_PATCH 00078 CALL GOTO_TEB(JPATCH) 00079 CALL WRITESURF_TEB_n(HPROGRAM,JPATCH,HWRITE) 00080 END DO 00081 ! 00082 CALL GOTO_TEB(1) 00083 IF ((.NOT.LNOWRITE_CANOPY).OR.LSELECT) CALL WRITESURF_TEB_CANOPY_n(HPROGRAM,HWRITE) 00084 ! 00085 !------------------------------------------------------------------------------- 00086 ! 00087 ! End of IO 00088 ! 00089 CALL END_IO_SURF_n(HPROGRAM) 00090 IF (LHOOK) CALL DR_HOOK('WRITE_TEB_N',1,ZHOOK_HANDLE) 00091 ! 00092 END SUBROUTINE WRITE_TEB_n