|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE WRITESURF_WATFLUX_SBL_n(HPROGRAM,HWRITE) 00003 ! #################################### 00004 ! 00005 !!**** *WRITE_WATFLUX_n* - writes WATFLUX fields 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 !! E. Martin 01/2012 avoid write of XUNDEF fields 00032 !------------------------------------------------------------------------------- 00033 ! 00034 !* 0. DECLARATIONS 00035 ! ------------ 00036 ! 00037 ! 00038 ! 00039 USE MODD_WATFLUX_n, ONLY : LSBL 00040 USE MODD_WATFLUX_SBL_n, ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XP 00041 ! 00042 USE MODI_WRITE_SURF 00043 ! 00044 ! 00045 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00046 USE PARKIND1 ,ONLY : JPRB 00047 ! 00048 IMPLICIT NONE 00049 ! 00050 !* 0.1 Declarations of arguments 00051 ! ------------------------- 00052 ! 00053 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling 00054 CHARACTER(LEN=3), INTENT(IN) :: HWRITE ! 'PREP' : does not write SBL XUNDEF fields 00055 ! ! 'ALL' : all fields are written 00056 ! 00057 !* 0.2 Declarations of local variables 00058 ! ------------------------------- 00059 ! 00060 INTEGER :: IRESP ! IRESP : return-code if a problem appears 00061 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00062 CHARACTER(LEN=100):: YCOMMENT ! Comment string 00063 ! 00064 INTEGER :: JLAYER ! loop counter on layers 00065 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00066 !------------------------------------------------------------------------------- 00067 ! 00068 !* 1. Prognostic fields: 00069 ! ----------------- 00070 ! 00071 !* flag to define if SBL is computed 00072 ! 00073 IF (LHOOK) CALL DR_HOOK('WRITESURF_WATFLUX_SBL_N',0,ZHOOK_HANDLE) 00074 YRECFM='WAT_SBL' 00075 YCOMMENT='flag to use SBL levels' 00076 CALL WRITE_SURF(HPROGRAM,YRECFM,LSBL,IRESP,HCOMMENT=YCOMMENT) 00077 ! 00078 IF (.NOT. LSBL .AND. LHOOK) CALL DR_HOOK('WRITESURF_WATFLUX_SBL_N',1,ZHOOK_HANDLE) 00079 IF (.NOT. LSBL) RETURN 00080 ! 00081 !* number of levels 00082 ! 00083 YRECFM='WAT_SBL_LVL' 00084 YCOMMENT='number of SBL levels' 00085 CALL WRITE_SURF(HPROGRAM,YRECFM,NLVL,IRESP,HCOMMENT=YCOMMENT) 00086 ! 00087 !* altitudes 00088 ! 00089 DO JLAYER=1,NLVL 00090 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' ' 00091 YCOMMENT='altitudes of SBL levels (m)' 00092 CALL WRITE_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP,HCOMMENT=YCOMMENT) 00093 END DO 00094 ! 00095 IF (HWRITE/='PRE') THEN 00096 ! 00097 !* wind in SBL 00098 ! 00099 DO JLAYER=1,NLVL 00100 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' ' 00101 YCOMMENT='wind at SBL levels (m/s)' 00102 CALL WRITE_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP,HCOMMENT=YCOMMENT) 00103 END DO 00104 ! 00105 !* temperature in SBL 00106 ! 00107 DO JLAYER=1,NLVL 00108 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' ' 00109 YCOMMENT='temperature at SBL levels (K)' 00110 CALL WRITE_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP,HCOMMENT=YCOMMENT) 00111 END DO 00112 ! 00113 !* humidity in SBL 00114 ! 00115 DO JLAYER=1,NLVL 00116 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' ' 00117 YCOMMENT='humidity at SBL levels (kg/m3)' 00118 CALL WRITE_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP,HCOMMENT=YCOMMENT) 00119 END DO 00120 ! 00121 !* Tke in SBL 00122 ! 00123 DO JLAYER=1,NLVL 00124 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' ' 00125 YCOMMENT='Tke at SBL levels (m2/s2)' 00126 CALL WRITE_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP,HCOMMENT=YCOMMENT) 00127 END DO 00128 ! 00129 !* Monin-Obhukov length 00130 ! 00131 YRECFM='WAT_SBL_LMO ' 00132 CALL WRITE_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP,HCOMMENT=YCOMMENT) 00133 ! 00134 !* Air pressure in SBL 00135 ! 00136 DO JLAYER=1,NLVL 00137 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' ' 00138 YCOMMENT='Pressure at SBL levels (Pa)' 00139 CALL WRITE_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP,HCOMMENT=YCOMMENT) 00140 END DO 00141 ! 00142 ENDIF 00143 ! 00144 IF (LHOOK) CALL DR_HOOK('WRITESURF_WATFLUX_SBL_N',1,ZHOOK_HANDLE) 00145 ! 00146 !------------------------------------------------------------------------------- 00147 ! 00148 END SUBROUTINE WRITESURF_WATFLUX_SBL_n
1.8.0
