SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE READ_WATFLUX_SBL_n(HPROGRAM) 00003 ! ######################################### 00004 ! 00005 !!**** *READ_WATFLUX_SBL_n* - reads WATFLUX fields 00006 !! 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! 00011 !!** METHOD 00012 !! ------ 00013 !! 00014 !! EXTERNAL 00015 !! -------- 00016 !! 00017 !! 00018 !! IMPLICIT ARGUMENTS 00019 !! ------------------ 00020 !! 00021 !! REFERENCE 00022 !! --------- 00023 !! 00024 !! 00025 !! AUTHOR 00026 !! ------ 00027 !! V. Masson *Meteo France* 00028 !! 00029 !! MODIFICATIONS 00030 !! ------------- 00031 !! Original 01/2003 00032 !! E. Martin 01/2012 Add LSBL_COLD_START 00033 !------------------------------------------------------------------------------- 00034 ! 00035 !* 0. DECLARATIONS 00036 ! ------------ 00037 ! 00038 USE MODD_SURF_PAR, ONLY : XUNDEF 00039 USE MODD_WATFLUX_n, ONLY : LSBL 00040 USE MODD_WATFLUX_SBL_n, ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XDZ, XZF, XDZF, XP 00041 ! 00042 USE MODI_READ_SURF 00043 USE MODI_CANOPY_GRID 00044 USE MODI_GET_TYPE_DIM_n 00045 ! 00046 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00047 USE PARKIND1 ,ONLY : JPRB 00048 ! 00049 IMPLICIT NONE 00050 ! 00051 !* 0.1 Declarations of arguments 00052 ! ------------------------- 00053 ! 00054 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program 00055 ! 00056 ! 00057 !* 0.2 Declarations of local variables 00058 ! ------------------------------- 00059 ! 00060 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00061 CHARACTER(LEN=3) :: YREAD 00062 INTEGER :: JLAYER ! loop counter on layers 00063 INTEGER :: ILU ! 1D physical dimension 00064 INTEGER :: IRESP ! Error code after redding 00065 INTEGER :: IVERSION, IBUGFIX ! surface version 00066 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00067 !------------------------------------------------------------------------------- 00068 ! 00069 !* 1D physical dimension 00070 ! 00071 IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',0,ZHOOK_HANDLE) 00072 CALL GET_TYPE_DIM_n('WATER ',ILU) 00073 ! 00074 !* flag to use or not SBL levels 00075 ! 00076 YRECFM='VERSION' 00077 CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP) 00078 ! 00079 YRECFM='BUG' 00080 CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP) 00081 ! 00082 YRECFM='WAT_SBL' 00083 CALL READ_SURF(HPROGRAM,YRECFM,LSBL,IRESP) 00084 ! 00085 IF (.NOT.LSBL) THEN 00086 ALLOCATE(XZ (0,0)) 00087 ALLOCATE(XU (0,0)) 00088 ALLOCATE(XT (0,0)) 00089 ALLOCATE(XQ (0,0)) 00090 ALLOCATE(XTKE(0,0)) 00091 ALLOCATE(XLMO(0) ) 00092 ALLOCATE(XP (0,0)) 00093 ALLOCATE(XDZ (0,0)) 00094 ALLOCATE(XZF (0,0)) 00095 ALLOCATE(XDZF(0,0)) 00096 IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',1,ZHOOK_HANDLE) 00097 RETURN 00098 ENDIF 00099 ! 00100 !* number of vertical levels 00101 ! 00102 YRECFM='WAT_SBL_LVL' 00103 CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP) 00104 ! 00105 !* 2. Prognostic fields: 00106 ! ----------------- 00107 ! 00108 !* altitudes 00109 ! 00110 ALLOCATE(XZ(ILU,NLVL)) 00111 ! 00112 DO JLAYER=1,NLVL 00113 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' ' 00114 CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP) 00115 END DO 00116 ! 00117 ALLOCATE(XU (ILU,NLVL)) 00118 ALLOCATE(XT (ILU,NLVL)) 00119 ALLOCATE(XQ (ILU,NLVL)) 00120 ALLOCATE(XTKE(ILU,NLVL)) 00121 ALLOCATE(XLMO(ILU) ) 00122 ALLOCATE(XP (ILU,NLVL)) 00123 ! 00124 IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN 00125 YRECFM='STORAGETYPE' 00126 CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP) 00127 ELSE 00128 YREAD = 'ALL' 00129 ENDIF 00130 ! 00131 IF(YREAD=='ALL') THEN 00132 ! 00133 !* wind in SBL 00134 DO JLAYER=1,NLVL 00135 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' ' 00136 CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP) 00137 END DO 00138 ! 00139 !* theta in SBL 00140 DO JLAYER=1,NLVL 00141 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' ' 00142 CALL READ_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP) 00143 END DO 00144 ! 00145 !* humidity in SBL 00146 DO JLAYER=1,NLVL 00147 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' ' 00148 CALL READ_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP) 00149 END DO 00150 ! 00151 !* Tke in SBL 00152 DO JLAYER=1,NLVL 00153 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' ' 00154 CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP) 00155 END DO 00156 ! 00157 !* Monin-Obhukov length 00158 YRECFM='WAT_SBL_LMO ' 00159 CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP) 00160 ! 00161 !* Pressure 00162 DO JLAYER=1,NLVL 00163 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' ' 00164 CALL READ_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP) 00165 END DO 00166 ! 00167 ELSE 00168 XU (:,:) = XUNDEF 00169 XT (:,:) = XUNDEF 00170 XQ (:,:) = XUNDEF 00171 XTKE(:,:) = XUNDEF 00172 XLMO(:) = XUNDEF 00173 XP (:,:) = XUNDEF 00174 ENDIF 00175 ! 00176 ! 00177 !* Grid characteristics 00178 ! 00179 ! 00180 ! --------------------------------- XZ(k+1) XDZ(k+1) 00181 ! ^ 00182 ! | 00183 ! | 00184 ! - - - - - - - - - - - - - - - - - XZf(k+1) | XDZf(k+1) 00185 ! ^ | 00186 ! | | 00187 ! --------------------------------- XZ(k), XU, XT, XQ, XTKE | XDZ(k) V 00188 ! | ^ 00189 ! - - - - - - - - - - - - - - - - - XZf(k) V | XDZf(k) 00190 ! --------------------------------- XZ(k-1) XDZ(k-1) V 00191 ! - - - - - - - - - - - - - - - - - XZf(k-1) 00192 ! 00193 ALLOCATE(XDZ (ILU,NLVL)) 00194 ALLOCATE(XZF (ILU,NLVL)) 00195 ALLOCATE(XDZF(ILU,NLVL)) 00196 CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF) 00197 ! 00198 IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',1,ZHOOK_HANDLE) 00199 ! 00200 !------------------------------------------------------------------------------- 00201 ! 00202 END SUBROUTINE READ_WATFLUX_SBL_n