SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE READ_FLAKE_SBL_n(HPROGRAM) 00003 ! ######################################### 00004 ! 00005 !!**** *READ_FLAKE_SBL_n* - reads FLAKE 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_FLAKE_n, ONLY : LSBL 00040 USE MODD_FLAKE_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 :: ILU ! 1D physical dimension 00063 INTEGER :: IRESP ! Error code after redding 00064 INTEGER :: JLAYER ! loop counter on layers 00065 INTEGER :: IVERSION, IBUGFIX 00066 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00067 ! 00068 !------------------------------------------------------------------------------- 00069 ! 00070 !* 1D physical dimension 00071 ! 00072 IF (LHOOK) CALL DR_HOOK('READ_FLAKE_SBL_N',0,ZHOOK_HANDLE) 00073 CALL GET_TYPE_DIM_n('WATER ',ILU) 00074 ! 00075 YRECFM='VERSION' 00076 CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP) 00077 ! 00078 YRECFM='BUG' 00079 CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP) 00080 ! 00081 !* flag to use or not SBL levels 00082 ! 00083 YRECFM='WAT_SBL' 00084 CALL READ_SURF(HPROGRAM,YRECFM,LSBL,IRESP) 00085 ! 00086 IF (.NOT.LSBL) THEN 00087 ALLOCATE(XZ (0,0)) 00088 ALLOCATE(XU (0,0)) 00089 ALLOCATE(XT (0,0)) 00090 ALLOCATE(XQ (0,0)) 00091 ALLOCATE(XTKE(0,0)) 00092 ALLOCATE(XLMO(0) ) 00093 ALLOCATE(XP (0,0)) 00094 ALLOCATE(XDZ (0,0)) 00095 ALLOCATE(XZF (0,0)) 00096 ALLOCATE(XDZF(0,0)) 00097 IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_SBL_N',1,ZHOOK_HANDLE) 00098 RETURN 00099 ENDIF 00100 ! 00101 !* number of vertical levels 00102 ! 00103 YRECFM='WAT_SBL_LVL' 00104 CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP) 00105 ! 00106 !* 2. Prognostic fields: 00107 ! ----------------- 00108 ! 00109 !* altitudes 00110 ! 00111 ALLOCATE(XZ(ILU,NLVL)) 00112 ! 00113 DO JLAYER=1,NLVL 00114 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' ' 00115 CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP) 00116 END DO 00117 ! 00118 ALLOCATE(XU (ILU,NLVL)) 00119 ALLOCATE(XT (ILU,NLVL)) 00120 ALLOCATE(XQ (ILU,NLVL)) 00121 ALLOCATE(XTKE(ILU,NLVL)) 00122 ALLOCATE(XLMO(ILU) ) 00123 ALLOCATE(XP (ILU,NLVL)) 00124 ! 00125 IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN 00126 YRECFM='STORAGETYPE' 00127 CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP) 00128 ELSE 00129 YREAD = 'ALL' 00130 ENDIF 00131 ! 00132 IF(YREAD=='ALL') THEN 00133 ! 00134 !* wind in SBL 00135 DO JLAYER=1,NLVL 00136 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' ' 00137 CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP) 00138 END DO 00139 ! 00140 !* theta in SBL 00141 DO JLAYER=1,NLVL 00142 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' ' 00143 CALL READ_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP) 00144 END DO 00145 ! 00146 !* humidity in SBL 00147 DO JLAYER=1,NLVL 00148 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' ' 00149 CALL READ_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP) 00150 END DO 00151 ! 00152 !* Tke in SBL 00153 DO JLAYER=1,NLVL 00154 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' ' 00155 CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP) 00156 END DO 00157 ! 00158 !* Monin-Obhukov length 00159 YRECFM='WAT_SBL_LMO ' 00160 CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP) 00161 ! 00162 !* Pressure 00163 DO JLAYER=1,NLVL 00164 WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' ' 00165 CALL READ_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP) 00166 END DO 00167 ! 00168 ELSE 00169 XU (:,:) = XUNDEF 00170 XT (:,:) = XUNDEF 00171 XQ (:,:) = XUNDEF 00172 XTKE(:,:) = XUNDEF 00173 XLMO(:) = XUNDEF 00174 XP (:,:) = XUNDEF 00175 ENDIF 00176 ! 00177 ! 00178 !* Grid characteristics 00179 ! 00180 ! 00181 ! --------------------------------- XZ(k+1) XDZ(k+1) 00182 ! ^ 00183 ! | 00184 ! | 00185 ! - - - - - - - - - - - - - - - - - XZf(k+1) | XDZf(k+1) 00186 ! ^ | 00187 ! | | 00188 ! --------------------------------- XZ(k), XU, XT, XQ, XTKE | XDZ(k) V 00189 ! | ^ 00190 ! - - - - - - - - - - - - - - - - - XZf(k) V | XDZf(k) 00191 ! --------------------------------- XZ(k-1) XDZ(k-1) V 00192 ! - - - - - - - - - - - - - - - - - XZf(k-1) 00193 ! 00194 ALLOCATE(XDZ (ILU,NLVL)) 00195 ALLOCATE(XZF (ILU,NLVL)) 00196 ALLOCATE(XDZF(ILU,NLVL)) 00197 CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF) 00198 ! 00199 IF (LHOOK) CALL DR_HOOK('READ_FLAKE_SBL_N',1,ZHOOK_HANDLE) 00200 ! 00201 !------------------------------------------------------------------------------- 00202 ! 00203 END SUBROUTINE READ_FLAKE_SBL_n