|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE GAUSS_INDEX(HPROGRAM,HFILE,HFLAG,OINDEX_STORE,HINDEX_1KM,& 00003 HINDEX_10KM,HINDEX_100KM,HRES_COMP) 00004 ! ##################################################################### 00005 !! 00006 !! PURPOSE 00007 !! ------- 00008 !! 00009 !! Read or calculate and store gauss indexes 00010 !! 00011 !! METHOD 00012 !! ------ 00013 !! 00014 !! EXTERNAL 00015 !! -------- 00016 !! 00017 !! 00018 !! IMPLICIT ARGUMENTS 00019 !! ------------------ 00020 !! 00021 !! 00022 !! REFERENCE 00023 !! --------- 00024 !! 00025 !! AUTHOR 00026 !! ------ 00027 !! 00028 !! B. Decharme Meteo-France 00029 !! 00030 !! MODIFICATION 00031 !! ------------ 00032 !! 00033 !! Original 02/2010 00034 !---------------------------------------------------------------------------- 00035 ! 00036 !* 0. DECLARATION 00037 ! ----------- 00038 ! 00039 USE MODD_PGD_GRID, ONLY : XMESHLENGTH 00040 USE MODD_PGDWORK, ONLY : NSSO 00041 ! 00042 USE MODI_GET_LUOUT 00043 USE MODI_INI_SSOWORK 00044 ! 00045 USE MODE_GAUSS_INDEX 00046 ! 00047 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00048 USE PARKIND1 ,ONLY : JPRB 00049 ! 00050 IMPLICIT NONE 00051 ! 00052 !* 0.1 Declaration of dummy arguments 00053 ! ------------------------------ 00054 ! 00055 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM 00056 CHARACTER(LEN=28), INTENT(IN) :: HFILE 00057 CHARACTER(LEN=6), INTENT(IN) :: HFLAG 00058 LOGICAL, INTENT(IN) :: OINDEX_STORE ! Store index in a binary file 00059 CHARACTER(LEN=28), INTENT(IN) :: HINDEX_1KM 00060 CHARACTER(LEN=28), INTENT(IN) :: HINDEX_10KM 00061 CHARACTER(LEN=28), INTENT(IN) :: HINDEX_100KM 00062 CHARACTER(LEN=5), INTENT(INOUT):: HRES_COMP 00063 ! 00064 ! 00065 !* 0.2 Declaration of local variables 00066 ! ------------------------------ 00067 ! 00068 CHARACTER(LEN=5) :: YRES ! Resolution in file 00069 REAL, DIMENSION(:), POINTER :: ZLAT ! latitude of data points 00070 REAL, DIMENSION(:), POINTER :: ZLON ! longitude of data points 00071 REAL :: ZDLAT ! latitude mesh in the data file 00072 REAL :: ZDLON ! longitude mesh in the data file 00073 INTEGER :: INDIM ! number of grid point in file 00074 INTEGER :: INLON ! number of longitude rows in file 00075 INTEGER :: INLAT ! number of latitude rows in file 00076 INTEGER :: ILUOUT ! output listing logical unit 00077 CHARACTER(LEN=28) :: YINDEX ! file name for gauss index 00078 ! 00079 INTEGER, DIMENSION(:), ALLOCATABLE :: IINDEX ! mesh index of all input points 00080 ! 0 indicates the point is out of the domain 00081 INTEGER, DIMENSION(:), ALLOCATABLE :: ISSOX ! X submesh index in their mesh of all input points 00082 INTEGER, DIMENSION(:), ALLOCATABLE :: ISSOY ! Y submesh index in their mesh of all input points 00083 ! 00084 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00085 ! 00086 !--------------------------------------------------------------- 00087 !* 1. Initializations 00088 !------------------------------------------------------------------------------- 00089 ! 00090 IF (LHOOK) CALL DR_HOOK('GAUSS_INDEX',0,ZHOOK_HANDLE) 00091 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00092 ! 00093 !------------------------------------------------------------------------------- 00094 !* 2. Read configuration 00095 !------------------------------------------------------------------------------- 00096 ! 00097 ! 00098 CALL READ_GAUSS_CONF(HPROGRAM,HFILE,HINDEX_1KM,HINDEX_10KM,HINDEX_100KM, & 00099 YINDEX,YRES,INDIM,INLON,INLAT,ZDLON,ZDLAT,ZLON,ZLAT) 00100 ! 00101 IF(HRES_COMP==YRES .AND. LHOOK) CALL DR_HOOK('GAUSS_INDEX',1,ZHOOK_HANDLE) 00102 IF(HRES_COMP==YRES)RETURN 00103 ! 00104 !------------------------------------------------------------------------------- 00105 !* 3. Read or calculate and store gauss indexes 00106 !------------------------------------------------------------------------------- 00107 ! 00108 HRES_COMP=YRES 00109 ! 00110 ALLOCATE(IINDEX(INDIM)) 00111 ! 00112 IF(HFLAG=='A_OROG')THEN 00113 ! Adapt subgrid mesh to input file resolution 00114 CALL INI_SSOWORK(XMESHLENGTH,ZDLAT,ZDLON) 00115 ALLOCATE(ISSOX (INDIM)) 00116 ALLOCATE(ISSOY (INDIM)) 00117 ENDIF 00118 ! 00119 IF(LEN_TRIM(YINDEX)/=0)THEN 00120 ! 00121 ! Read input index file 00122 ! 00123 IF(HFLAG=='A_OROG')THEN 00124 CALL READ_INDEX_GAUSS(HPROGRAM,YINDEX,INLON,INLAT,IINDEX,KSSOX=ISSOX,KSSOY=ISSOY) 00125 ELSE 00126 CALL READ_INDEX_GAUSS(HPROGRAM,YINDEX,INLON,INLAT,IINDEX) 00127 ENDIF 00128 ! 00129 WRITE(ILUOUT,*) ' ' 00130 WRITE(ILUOUT,*) '***********************************************************' 00131 WRITE(ILUOUT,*) '* Read input gauss index file at '//YRES//' *' 00132 WRITE(ILUOUT,*) '***********************************************************' 00133 WRITE(ILUOUT,*) ' ' 00134 ! 00135 ELSE 00136 ! 00137 ! Calulate index 00138 ! 00139 IF(HFLAG=='A_OROG')THEN 00140 CALL GET_INDEX_GAUSS(ILUOUT,ZLON,ZLAT,IINDEX,KSSO=NSSO,KSSOX=ISSOX,KSSOY=ISSOY) 00141 ELSE 00142 CALL GET_INDEX_GAUSS(ILUOUT,ZLON,ZLAT,IINDEX) 00143 ENDIF 00144 ! 00145 DEALLOCATE(ZLON) 00146 DEALLOCATE(ZLAT) 00147 ! 00148 WRITE(ILUOUT,*) ' ' 00149 WRITE(ILUOUT,*) '***********************************************************' 00150 WRITE(ILUOUT,*) '* Calulate gauss index file at '//YRES//' *' 00151 WRITE(ILUOUT,*) '***********************************************************' 00152 WRITE(ILUOUT,*) ' ' 00153 ! 00154 ! Store index 00155 ! 00156 IF(OINDEX_STORE)THEN 00157 ! 00158 IF(HFLAG=='A_OROG')THEN 00159 CALL STORE_INDEX_GAUSS(HPROGRAM,YRES,INLON,INLAT,IINDEX,KSSOX=ISSOX,KSSOY=ISSOY) 00160 ELSE 00161 CALL STORE_INDEX_GAUSS(HPROGRAM,YRES,INLON,INLAT,IINDEX) 00162 ENDIF 00163 ! 00164 WRITE(ILUOUT,*) ' ' 00165 WRITE(ILUOUT,*) '***********************************************************' 00166 WRITE(ILUOUT,*) '* Store gauss index file at '//YRES//' *' 00167 WRITE(ILUOUT,*) '***********************************************************' 00168 WRITE(ILUOUT,*) ' ' 00169 ! 00170 ENDIF 00171 ! 00172 ENDIF 00173 IF (LHOOK) CALL DR_HOOK('GAUSS_INDEX',1,ZHOOK_HANDLE) 00174 ! 00175 !------------------------------------------------------------------------------- 00176 ! 00177 END SUBROUTINE GAUSS_INDEX
1.8.0
