|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 MODULE MODE_READ_SURF_OL 00002 ! 00003 !! PURPOSE 00004 !! ------- 00005 ! 00006 ! The purpose of READ_SURF_OL is 00007 ! 00008 !!** METHOD 00009 !! ------ 00010 !! 00011 !! EXTERNAL 00012 !! -------- 00013 !! 00014 !! 00015 !! 00016 !! IMPLICIT ARGUMENTS 00017 !! ------------------ 00018 !! 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! 00024 !! AUTHOR 00025 !! ------ 00026 !! 00027 !! F. Habets *METEO-FRANCE* 00028 !! 00029 !! MODIFICATIONS 00030 !! ------------- 00031 !! 00032 !! original 01/08/03 00033 !---------------------------------------------------------------------------- 00034 ! 00035 INTERFACE READ_SURF0_OL 00036 MODULE PROCEDURE READ_SURFX0_OL 00037 MODULE PROCEDURE READ_SURFN0_OL 00038 MODULE PROCEDURE READ_SURFC0_OL 00039 MODULE PROCEDURE READ_SURFL0_OL 00040 END INTERFACE 00041 INTERFACE READ_SURFN_OL 00042 MODULE PROCEDURE READ_SURFX1_OL 00043 MODULE PROCEDURE READ_SURFN1_OL 00044 MODULE PROCEDURE READ_SURFL1_OL 00045 MODULE PROCEDURE READ_SURFX2_OL 00046 MODULE PROCEDURE READ_SURFX3_OL 00047 END INTERFACE 00048 INTERFACE READ_SURFT_OL 00049 MODULE PROCEDURE READ_SURFT0_OL 00050 END INTERFACE 00051 ! 00052 CONTAINS 00053 ! 00054 ! ############################################################# 00055 SUBROUTINE READ_SURFX0_OL(HREC,PFIELD,KRESP,HCOMMENT) 00056 ! ############################################################# 00057 ! 00058 !!**** *READX0* - routine to read a real scalar 00059 ! 00060 USE MODD_SURF_PAR, ONLY: XUNDEF 00061 ! 00062 USE MODI_OL_FIND_FILE_READ 00063 USE MODI_ERROR_READ_SURF_OL 00064 ! 00065 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00066 USE PARKIND1 ,ONLY : JPRB 00067 ! 00068 IMPLICIT NONE 00069 ! 00070 INCLUDE "netcdf.inc" 00071 ! 00072 !* 0.1 Declarations of arguments 00073 ! 00074 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00075 REAL, INTENT(OUT) :: PFIELD ! the real scalar to be read 00076 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00077 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00078 ! 00079 !* 0.2 Declarations of local variables 00080 ! 00081 REAL*4 :: ZFIELD 00082 CHARACTER(LEN=100) :: YFILE ! filename 00083 INTEGER :: IVAR_ID,IFILE_ID,JRET,IVAL,ITYPE,INDIMS 00084 INTEGER,DIMENSION(4) :: IRET 00085 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00086 ! 00087 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFX0_OL',0,ZHOOK_HANDLE) 00088 ! 00089 KRESP=0 00090 HCOMMENT = " " 00091 ! 00092 ! 0. find filename 00093 ! ----------------- 00094 CALL OL_FIND_FILE_READ(HREC,IFILE_ID) 00095 ! 00096 IF (IFILE_ID.NE.0) THEN 00097 ! 00098 ! 1. Find id of the variable 00099 !---------------------------- 00100 IRET(1)=NF_INQ_VARID (IFILE_ID,HREC,IVAR_ID) 00101 IRET(1)=NF_INQ_VARTYPE (IFILE_ID,IVAR_ID,ITYPE) 00102 IRET(1)=NF_INQ_VARNDIMS(IFILE_ID,IVAR_ID,INDIMS) 00103 ! 00104 ! 2. Get variable 00105 !---------------------------- 00106 IF (ITYPE==NF_DOUBLE) THEN 00107 IRET(2)=NF_GET_VAR_DOUBLE(IFILE_ID,IVAR_ID,PFIELD) 00108 ELSEIF (ITYPE==NF_FLOAT) THEN 00109 IRET(2)=NF_GET_VAR_REAL(IFILE_ID,IVAR_ID,ZFIELD) 00110 PFIELD = ZFIELD 00111 ENDIF 00112 ! 00113 ENDIF 00114 ! 00115 ! 3. Check for errors 00116 !-------------------- 00117 DO JRET=1,2 00118 IF ((PFIELD==XUNDEF).OR.(IFILE_ID==0).OR.IRET(JRET).NE.NF_NOERR) THEN 00119 PFIELD=XUNDEF 00120 KRESP=1 00121 ENDIF 00122 ENDDO 00123 ! 00124 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(HREC,KRESP) 00125 ! 00126 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFX0_OL',1,ZHOOK_HANDLE) 00127 ! 00128 END SUBROUTINE READ_SURFX0_OL 00129 ! 00130 ! ############################################################# 00131 SUBROUTINE READ_SURFX1_OL(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00132 ! ############################################################# 00133 ! 00134 !!**** *READX1* - routine to fill a real 1D array for the externalised surface 00135 ! 00136 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_READ 00137 ! 00138 USE MODD_IO_SURF_OL, ONLY: LMASK,NMASK,XSTART,XCOUNT,XSTRIDE,LPARTR 00139 ! 00140 USE MODD_SURF_PAR, ONLY: XUNDEF 00141 ! 00142 USE MODI_OL_FIND_FILE_READ 00143 USE MODI_ERROR_READ_SURF_OL 00144 USE MODI_READ_AND_SEND_MPI 00145 ! 00146 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00147 USE PARKIND1 ,ONLY : JPRB 00148 ! 00149 IMPLICIT NONE 00150 ! 00151 INCLUDE "netcdf.inc" 00152 ! 00153 #ifndef NOMPI 00154 INCLUDE "mpif.h" 00155 #endif 00156 ! 00157 !* 0.1 Declarations of arguments 00158 ! 00159 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00160 REAL, DIMENSION(:), INTENT(OUT) :: PFIELD ! array containing the data field 00161 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00162 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00163 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00164 ! 'H' : field with 00165 ! horizontal spatial dim. 00166 ! '-' : no horizontal dim. 00167 !* 0.2 Declarations of local variables 00168 ! 00169 CHARACTER(LEN=100) :: YFILE,YOUT ! Filename 00170 INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS, ITYPE 00171 INTEGER,DIMENSION(2) :: IDIMIDS,IDIMLEN 00172 INTEGER,DIMENSION(2) :: IRET 00173 ! 00174 INTEGER,DIMENSION(:),ALLOCATABLE :: ISTART,ICOUNT,ISTRIDE 00175 REAL, DIMENSION(:), ALLOCATABLE :: ZTAB_1D ! work array read in the file 00176 REAL*4, DIMENSION(:), ALLOCATABLE :: ZTAB_1D4 00177 DOUBLE PRECISION :: XTIME0 00178 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00179 ! 00180 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFX1_OL',0,ZHOOK_HANDLE) 00181 ! 00182 KRESP=0 00183 HCOMMENT = " " 00184 ! 00185 #ifndef NOMPI 00186 XTIME0 = MPI_WTIME() 00187 #endif 00188 ! 00189 IF (NRANK==NPIO) THEN 00190 ! 00191 !$OMP SINGLE 00192 ! 00193 ! 0. find filename 00194 ! ----------------- 00195 CALL OL_FIND_FILE_READ(HREC,IFILE_ID) 00196 ! 00197 IF (IFILE_ID.NE.0) THEN 00198 ! 00199 ! 1. Find id of the variable 00200 !---------------------------- 00201 IRET(1)=NF_INQ_VARID (IFILE_ID,HREC,IVAR_ID) 00202 IRET(1)=NF_INQ_VARTYPE (IFILE_ID,IVAR_ID,ITYPE) 00203 IRET(1)=NF_INQ_VARNDIMS(IFILE_ID,IVAR_ID,INDIMS) 00204 IRET(1)=NF_INQ_VARDIMID(IFILE_ID,IVAR_ID,IDIMIDS(1:INDIMS)) 00205 IDIMLEN(:) = 1. 00206 DO JDIM=1,INDIMS 00207 JRET=NF_INQ_DIMLEN(IFILE_ID,IDIMIDS(JDIM),IDIMLEN(JDIM)) 00208 ENDDO 00209 ALLOCATE(ZTAB_1D(IDIMLEN(1)*IDIMLEN(2))) 00210 ! 00211 ! 2. Get variable 00212 !---------------------------- 00213 IF (LPARTR) THEN 00214 ! write partially a time-matrix. 00215 ! Have to find which of the dimension is the time dimension 00216 ALLOCATE(ISTART(INDIMS)) 00217 ALLOCATE(ICOUNT(INDIMS)) 00218 ALLOCATE(ISTRIDE(INDIMS)) 00219 DO JDIM=1,INDIMS 00220 IRET=NF_INQ_DIMNAME(IFILE_ID,IDIMIDS(JDIM),YOUT) 00221 IF ((INDEX(YOUT,'time') > 0).OR.(INDEX(YOUT,'TIME') >0) & 00222 .OR.(INDEX(YOUT,'Time')>0.)) THEN 00223 ISTART(JDIM)=XSTART 00224 ICOUNT(JDIM)=XCOUNT 00225 ISTRIDE(JDIM)=XSTRIDE 00226 ELSE 00227 ISTART(JDIM)=1 00228 ICOUNT(JDIM)=IDIMLEN(JDIM) 00229 ISTRIDE(JDIM)=1 00230 ENDIF 00231 ENDDO 00232 00233 IF (ITYPE==NF_DOUBLE) THEN 00234 IRET(1)=NF_GET_VARS_DOUBLE(IFILE_ID,IVAR_ID,ISTART,ICOUNT,ISTRIDE,ZTAB_1D) 00235 ELSEIF (ITYPE==NF_FLOAT) THEN 00236 ALLOCATE(ZTAB_1D4(IDIMLEN(1)*IDIMLEN(2))) 00237 IRET(1)=NF_GET_VARS_REAL(IFILE_ID,IVAR_ID,ISTART,ICOUNT,ISTRIDE,ZTAB_1D4) 00238 ZTAB_1D(:) = ZTAB_1D4(:) 00239 DEALLOCATE(ZTAB_1D4) 00240 ENDIF 00241 00242 DEALLOCATE(ISTART) 00243 DEALLOCATE(ICOUNT) 00244 DEALLOCATE(ISTRIDE) 00245 00246 ELSE 00247 IF (ITYPE==NF_DOUBLE) THEN 00248 IRET(1)=NF_GET_VAR_DOUBLE(IFILE_ID,IVAR_ID,ZTAB_1D) 00249 ELSEIF (ITYPE==NF_FLOAT) THEN 00250 ALLOCATE(ZTAB_1D4(IDIMLEN(1)*IDIMLEN(2))) 00251 IRET(1)=NF_GET_VAR_REAL(IFILE_ID,IVAR_ID,ZTAB_1D4) 00252 ZTAB_1D(:) = ZTAB_1D4(:) 00253 DEALLOCATE(ZTAB_1D4) 00254 ENDIF 00255 ENDIF 00256 ! 00257 ENDIF 00258 ! 00259 ! 3. Check for errors 00260 !-------------------- 00261 DO JRET=1,1 00262 IF ((IFILE_ID==0).OR.IRET(JRET).NE.NF_NOERR) THEN 00263 ZTAB_1D = XUNDEF 00264 KRESP=1 00265 ELSE 00266 IF (MINVAL(ZTAB_1D)==XUNDEF) THEN 00267 KRESP = 1 00268 ZTAB_1D = XUNDEF 00269 ENDIF 00270 ENDIF 00271 ENDDO 00272 ! 00273 !$OMP END SINGLE COPYPRIVATE(ZTAB_1D,HCOMMENT,KRESP) 00274 ! 00275 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(HREC,KRESP) 00276 ! 00277 ELSE 00278 ALLOCATE(ZTAB_1D(0)) 00279 ENDIF 00280 ! 00281 #ifndef NOMPI 00282 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0) 00283 #endif 00284 ! 00285 IF (LMASK) THEN 00286 CALL READ_AND_SEND_MPI(ZTAB_1D,PFIELD,NMASK) 00287 ELSE 00288 CALL READ_AND_SEND_MPI(ZTAB_1D,PFIELD) 00289 END IF 00290 ! 00291 DEALLOCATE(ZTAB_1D) 00292 ! 00293 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFX1_OL',1,ZHOOK_HANDLE) 00294 ! 00295 END SUBROUTINE READ_SURFX1_OL 00296 ! 00297 ! ############################################################# 00298 SUBROUTINE READ_SURFX2_OL(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00299 ! ############################################################# 00300 ! 00301 !!**** *READX2* - routine to fill a real 2D array for the externalised surface 00302 ! 00303 USE MODD_SURFEX_MPI, ONLY: NRANK, NPIO, XTIME_NPIO_READ 00304 ! 00305 USE MODD_IO_SURF_OL, ONLY: LMASK,NMASK,XSTART,XCOUNT,XSTRIDE,LPARTR 00306 USE MODD_SURF_PAR, ONLY: XUNDEF 00307 ! 00308 USE MODI_OL_FIND_FILE_READ 00309 USE MODI_ERROR_READ_SURF_OL 00310 USE MODI_READ_AND_SEND_MPI 00311 ! 00312 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00313 USE PARKIND1 ,ONLY : JPRB 00314 ! 00315 IMPLICIT NONE 00316 ! 00317 INCLUDE "netcdf.inc" 00318 ! 00319 #ifndef NOMPI 00320 INCLUDE "mpif.h" 00321 #endif 00322 ! 00323 !* 0.1 Declarations of arguments 00324 ! 00325 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00326 REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD ! array containing the data field 00327 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00328 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00329 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00330 ! 'H' : field with 00331 ! horizontal spatial dim. 00332 ! '-' : no horizontal dim. 00333 !* 0.2 Declarations of local variables 00334 ! 00335 CHARACTER(LEN=100) :: YFILE,YOUT ! filename 00336 INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS,ITYPE 00337 INTEGER,DIMENSION(3) :: IDIMIDS,IDIMLEN 00338 INTEGER,DIMENSION(2) :: IRET 00339 INTEGER, DIMENSION(:), ALLOCATABLE :: ISTART,ISTRIDE,ICOUNT 00340 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAB_2D ! work array read in the file 00341 REAL*4, DIMENSION(:,:), ALLOCATABLE :: ZTAB_2D4 00342 DOUBLE PRECISION :: XTIME0 00343 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00344 ! 00345 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFX2_OL',0,ZHOOK_HANDLE) 00346 ! 00347 KRESP=0 00348 HCOMMENT = " " 00349 ! 00350 #ifndef NOMPI 00351 XTIME0 = MPI_WTIME() 00352 #endif 00353 ! 00354 IF (NRANK==NPIO) THEN 00355 ! 00356 !$OMP SINGLE 00357 ! 00358 ! 0. find filename 00359 ! ----------------- 00360 CALL OL_FIND_FILE_READ(HREC,IFILE_ID) 00361 ! 00362 IF (IFILE_ID.NE.0) THEN 00363 ! 00364 ! 1. Find id of the variable 00365 !---------------------------- 00366 IRET(1)=NF_INQ_VARID (IFILE_ID,HREC,IVAR_ID) 00367 IRET(1)=NF_INQ_VARTYPE (IFILE_ID,IVAR_ID,ITYPE) 00368 IRET(1)=NF_INQ_VARNDIMS(IFILE_ID,IVAR_ID,INDIMS) 00369 IRET(1)=NF_INQ_VARDIMID(IFILE_ID,IVAR_ID,IDIMIDS(1:INDIMS)) 00370 IDIMLEN(:) = 1. 00371 DO JDIM=1,INDIMS 00372 JRET=NF_INQ_DIMLEN(IFILE_ID,IDIMIDS(JDIM),IDIMLEN(JDIM)) 00373 ENDDO 00374 ! 00375 ! 2. Get variable 00376 !---------------------------- 00377 IF (LPARTR) THEN 00378 ! write partially a time-matrix. 00379 ! Have to find which of the dimension is the time dimension 00380 ALLOCATE(ISTART(INDIMS)) 00381 ALLOCATE(ICOUNT(INDIMS)) 00382 ICOUNT(:) = 1. 00383 ALLOCATE(ISTRIDE(INDIMS)) 00384 DO JDIM=1,INDIMS 00385 IRET=NF_INQ_DIMNAME(IFILE_ID,IDIMIDS(JDIM),YOUT) 00386 IF ((INDEX(YOUT,'time') > 0).OR.(INDEX(YOUT,'TIME') >0) & 00387 .OR.(INDEX(YOUT,'Time')>0.)) THEN 00388 ISTART(JDIM)=XSTART 00389 ICOUNT(JDIM)=XCOUNT 00390 ISTRIDE(JDIM)=XSTRIDE 00391 ELSE 00392 ISTART(JDIM)=1 00393 ICOUNT(JDIM)=IDIMLEN(JDIM) 00394 ISTRIDE(JDIM)=1 00395 ENDIF 00396 ENDDO 00397 00398 ALLOCATE(ZTAB_2D(PRODUCT(ICOUNT(1:INDIMS-1)),ICOUNT(INDIMS))) 00399 IF (ITYPE==NF_DOUBLE) THEN 00400 IRET(2)=NF_GET_VARS_DOUBLE(IFILE_ID,IVAR_ID,ISTART,ICOUNT,ISTRIDE,ZTAB_2D) 00401 ELSEIF (ITYPE==NF_FLOAT) THEN 00402 ALLOCATE(ZTAB_2D4(PRODUCT(ICOUNT(1:INDIMS-1)),ICOUNT(INDIMS))) 00403 IRET(2)=NF_GET_VARS_REAL(IFILE_ID,IVAR_ID,ISTART,ICOUNT,ISTRIDE,ZTAB_2D4) 00404 ZTAB_2D(:,:) = ZTAB_2D4(:,:) 00405 DEALLOCATE(ZTAB_2D4) 00406 ENDIF 00407 DEALLOCATE(ISTART) 00408 DEALLOCATE(ICOUNT) 00409 DEALLOCATE(ISTRIDE) 00410 00411 ELSE 00412 ALLOCATE(ZTAB_2D(PRODUCT(IDIMLEN(1:INDIMS-1)),IDIMLEN(INDIMS))) 00413 IF (ITYPE==NF_DOUBLE) THEN 00414 IRET(2)=NF_GET_VAR_DOUBLE(IFILE_ID,IVAR_ID,ZTAB_2D) 00415 ELSEIF (ITYPE==NF_FLOAT) THEN 00416 ALLOCATE(ZTAB_2D4(PRODUCT(IDIMLEN(1:INDIMS-1)),IDIMLEN(INDIMS))) 00417 IRET(2)=NF_GET_VAR_REAL(IFILE_ID,IVAR_ID,ZTAB_2D4) 00418 ZTAB_2D(:,:) = ZTAB_2D4(:,:) 00419 DEALLOCATE(ZTAB_2D4) 00420 ENDIF 00421 ENDIF 00422 00423 ENDIF 00424 00425 ! 3. Check for errors 00426 !-------------------- 00427 DO JRET=1,2 00428 IF ((IFILE_ID==0).OR.IRET(JRET).NE.NF_NOERR) THEN 00429 ZTAB_2D = XUNDEF 00430 KRESP=1 00431 ELSE 00432 IF (MINVAL(ZTAB_2D)==XUNDEF) THEN 00433 KRESP=1 00434 ZTAB_2D = XUNDEF 00435 ENDIF 00436 ENDIF 00437 ENDDO 00438 ! 00439 !$OMP END SINGLE COPYPRIVATE(ZTAB_2D,HCOMMENT,KRESP) 00440 ! 00441 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(HREC,KRESP) 00442 ! 00443 ELSE 00444 ALLOCATE(ZTAB_2D(0,0)) 00445 ENDIF 00446 ! 00447 #ifndef NOMPI 00448 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0) 00449 #endif 00450 ! 00451 IF (LMASK) THEN 00452 CALL READ_AND_SEND_MPI(ZTAB_2D,PFIELD,NMASK) 00453 ELSE 00454 CALL READ_AND_SEND_MPI(ZTAB_2D,PFIELD) 00455 END IF 00456 ! 00457 DEALLOCATE(ZTAB_2D) 00458 ! 00459 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFX2_OL',1,ZHOOK_HANDLE) 00460 ! 00461 END SUBROUTINE READ_SURFX2_OL 00462 ! 00463 ! ############################################################# 00464 SUBROUTINE READ_SURFX3_OL(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00465 ! ############################################################# 00466 ! 00467 !!**** *READX3* - routine to fill a real 2D array for the externalised surface 00468 ! 00469 USE MODD_SURFEX_MPI, ONLY: NRANK, NPIO, XTIME_NPIO_READ 00470 ! 00471 USE MODD_IO_SURF_OL, ONLY: LMASK,NMASK,XSTART,XCOUNT,XSTRIDE,LPARTR 00472 USE MODD_SURF_PAR, ONLY: XUNDEF 00473 ! 00474 USE MODI_OL_FIND_FILE_READ 00475 USE MODI_ERROR_READ_SURF_OL 00476 USE MODI_READ_AND_SEND_MPI 00477 ! 00478 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00479 USE PARKIND1 ,ONLY : JPRB 00480 ! 00481 IMPLICIT NONE 00482 ! 00483 INCLUDE "netcdf.inc" 00484 ! 00485 #ifndef NOMPI 00486 INCLUDE "mpif.h" 00487 #endif 00488 ! 00489 !* 0.1 Declarations of arguments 00490 ! 00491 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00492 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD ! array containing the data field 00493 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00494 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00495 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00496 ! 'H' : field with 00497 ! horizontal spatial dim. 00498 ! '-' : no horizontal dim. 00499 !* 0.2 Declarations of local variables 00500 ! 00501 CHARACTER(LEN=100) :: YFILE,YOUT ! filename 00502 INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS,ITYPE 00503 INTEGER,DIMENSION(3) :: IDIMIDS,IDIMLEN 00504 INTEGER,DIMENSION(2) :: IRET 00505 INTEGER, DIMENSION(:), ALLOCATABLE :: ISTART,ISTRIDE,ICOUNT 00506 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAB_3D ! work array read in the file 00507 REAL*4, DIMENSION(:,:,:), ALLOCATABLE :: ZTAB_3D4 00508 DOUBLE PRECISION :: XTIME0 00509 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00510 ! 00511 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFX3_OL',0,ZHOOK_HANDLE) 00512 ! 00513 KRESP=0 00514 HCOMMENT = " " 00515 ! 00516 #ifndef NOMPI 00517 XTIME0 = MPI_WTIME() 00518 #endif 00519 ! 00520 IF (NRANK==NPIO) THEN 00521 ! 00522 !$OMP SINGLE 00523 ! 00524 ! 0. find filename 00525 ! ----------------- 00526 CALL OL_FIND_FILE_READ(HREC,IFILE_ID) 00527 ! 00528 IF (IFILE_ID.NE.0) THEN 00529 ! 00530 ! 1. Find id of the variable 00531 !---------------------------- 00532 IRET(1)=NF_INQ_VARID (IFILE_ID,HREC,IVAR_ID) 00533 IRET(1)=NF_INQ_VARTYPE (IFILE_ID,IVAR_ID,ITYPE) 00534 IRET(1)=NF_INQ_VARNDIMS(IFILE_ID,IVAR_ID,INDIMS) 00535 IRET(1)=NF_INQ_VARDIMID(IFILE_ID,IVAR_ID,IDIMIDS(1:INDIMS)) 00536 DO JDIM=1,INDIMS 00537 JRET=NF_INQ_DIMLEN(IFILE_ID,IDIMIDS(JDIM),IDIMLEN(JDIM)) 00538 ENDDO 00539 ! 00540 ! 2. Get variable 00541 !---------------------------- 00542 IF (LPARTR) THEN 00543 ! write partially a time-matrix. 00544 ! Have to find which of the dimension is the time dimension 00545 ALLOCATE(ISTART(INDIMS)) 00546 ALLOCATE(ICOUNT(INDIMS)) 00547 ALLOCATE(ISTRIDE(INDIMS)) 00548 DO JDIM=1,INDIMS 00549 IRET=NF_INQ_DIMNAME(IFILE_ID,IDIMIDS(JDIM),YOUT) 00550 IF ((INDEX(YOUT,'time') > 0).OR.(INDEX(YOUT,'TIME') >0) & 00551 .OR.(INDEX(YOUT,'Time')>0.)) THEN 00552 ISTART(JDIM)=XSTART 00553 ICOUNT(JDIM)=XCOUNT 00554 ISTRIDE(JDIM)=XSTRIDE 00555 ELSE 00556 ISTART(JDIM)=1 00557 ICOUNT(JDIM)=IDIMLEN(JDIM) 00558 ISTRIDE(JDIM)=1 00559 ENDIF 00560 ENDDO 00561 00562 ALLOCATE(ZTAB_3D(ICOUNT(1),ICOUNT(2),ICOUNT(3))) 00563 00564 IF (ITYPE==NF_DOUBLE) THEN 00565 IRET(2)=NF_GET_VARS_DOUBLE(IFILE_ID,IVAR_ID,ISTART,ICOUNT,ISTRIDE,ZTAB_3D) 00566 ELSEIF (ITYPE==NF_FLOAT) THEN 00567 ALLOCATE(ZTAB_3D4(ICOUNT(1),ICOUNT(2),ICOUNT(3))) 00568 IRET(2)=NF_GET_VARS_REAL(IFILE_ID,IVAR_ID,ISTART,ICOUNT,ISTRIDE,ZTAB_3D4) 00569 ZTAB_3D(:,:,:) = ZTAB_3D4(:,:,:) 00570 DEALLOCATE(ZTAB_3D4) 00571 ENDIF 00572 DEALLOCATE(ISTART) 00573 DEALLOCATE(ICOUNT) 00574 DEALLOCATE(ISTRIDE) 00575 ! 00576 ELSE 00577 ALLOCATE(ZTAB_3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3))) 00578 IF (ITYPE==NF_DOUBLE) THEN 00579 IRET(2)=NF_GET_VAR_DOUBLE(IFILE_ID,IVAR_ID,ZTAB_3D) 00580 ELSEIF (ITYPE==NF_FLOAT) THEN 00581 ALLOCATE(ZTAB_3D4(ICOUNT(1),ICOUNT(2),ICOUNT(3))) 00582 IRET(2)=NF_GET_VAR_REAL(IFILE_ID,IVAR_ID,ZTAB_3D4) 00583 ZTAB_3D(:,:,:) = ZTAB_3D4(:,:,:) 00584 DEALLOCATE(ZTAB_3D4) 00585 ENDIF 00586 ENDIF 00587 ! 00588 ENDIF 00589 ! 00590 ! 3. Check for errors 00591 !-------------------- 00592 DO JRET=1,2 00593 IF ((IFILE_ID==0).OR.IRET(JRET).NE.NF_NOERR) THEN 00594 ZTAB_3D = XUNDEF 00595 KRESP = 1 00596 ELSE 00597 IF (MINVAL(ZTAB_3D)==XUNDEF) THEN 00598 KRESP = 1 00599 ZTAB_3D = XUNDEF 00600 ENDIF 00601 ENDIF 00602 ENDDO 00603 ! 00604 !$OMP END SINGLE COPYPRIVATE(ZTAB_3D,HCOMMENT,KRESP) 00605 ! 00606 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(HREC,KRESP) 00607 ! 00608 ELSE 00609 ALLOCATE(ZTAB_3D(0,0,0)) 00610 ENDIF 00611 ! 00612 #ifndef NOMPI 00613 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0) 00614 #endif 00615 ! 00616 IF (LMASK) THEN 00617 CALL READ_AND_SEND_MPI(ZTAB_3D,PFIELD,NMASK) 00618 ELSE 00619 CALL READ_AND_SEND_MPI(ZTAB_3D,PFIELD) 00620 END IF 00621 ! 00622 DEALLOCATE(ZTAB_3D) 00623 ! 00624 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFX3_OL',1,ZHOOK_HANDLE) 00625 ! 00626 END SUBROUTINE READ_SURFX3_OL 00627 ! 00628 ! ############################################################# 00629 SUBROUTINE READ_SURFN0_OL(HREC,KFIELD,KRESP,HCOMMENT) 00630 ! ############################################################# 00631 ! 00632 !!**** *READN0* - routine to read an integer 00633 ! 00634 USE MODD_SURF_PAR, ONLY: NUNDEF 00635 ! 00636 USE MODI_OL_FIND_FILE_READ 00637 USE MODI_ERROR_READ_SURF_OL 00638 ! 00639 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00640 USE PARKIND1 ,ONLY : JPRB 00641 ! 00642 IMPLICIT NONE 00643 ! 00644 INCLUDE "netcdf.inc" 00645 ! 00646 !* 0.1 Declarations of arguments 00647 ! 00648 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00649 INTEGER, INTENT(OUT) :: KFIELD ! the integer scalar to be read 00650 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00651 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00652 ! 00653 ! 00654 !* 0.2 Declarations of local variables 00655 ! 00656 CHARACTER(LEN=100):: YFILE ! filename 00657 INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS 00658 INTEGER,DIMENSION(4) :: IRET 00659 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00660 ! 00661 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFN0_OL',0,ZHOOK_HANDLE) 00662 ! 00663 KRESP=0 00664 HCOMMENT = " " 00665 ! 00666 ! 0. find filename 00667 ! ----------------- 00668 CALL OL_FIND_FILE_READ(HREC,IFILE_ID) 00669 ! 00670 IF (IFILE_ID.NE.0) THEN 00671 ! 00672 ! 1. Find id of the variable 00673 !---------------------------- 00674 IRET(1)=NF_INQ_VARID (IFILE_ID,HREC,IVAR_ID) 00675 ! 00676 ! 2. Get variable 00677 !---------------------------- 00678 IRET(2)=NF_GET_VAR_INT(IFILE_ID,IVAR_ID,KFIELD) 00679 ! 00680 ENDIF 00681 ! 00682 ! 3. Check for errors 00683 !-------------------- 00684 DO JRET=1,2 00685 IF ((KFIELD==NUNDEF).OR.(IFILE_ID==0).OR.IRET(JRET).NE.NF_NOERR) THEN 00686 KFIELD=NUNDEF 00687 KRESP=1 00688 ENDIF 00689 ENDDO 00690 ! 00691 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(HREC,KRESP) 00692 ! 00693 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFN0_OL',1,ZHOOK_HANDLE) 00694 ! 00695 END SUBROUTINE READ_SURFN0_OL 00696 ! 00697 ! ############################################################# 00698 SUBROUTINE READ_SURFN1_OL(HREC,KFIELD,KRESP,HCOMMENT,HDIR) 00699 ! ############################################################# 00700 ! 00701 !!**** *READN0* - routine to read an integer 00702 ! 00703 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00704 USE PARKIND1 ,ONLY : JPRB 00705 ! 00706 IMPLICIT NONE 00707 ! 00708 !* 0.1 Declarations of arguments 00709 ! 00710 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00711 INTEGER, DIMENSION(:), INTENT(OUT) :: KFIELD ! the integer scalar to be read 00712 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00713 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00714 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00715 ! 'H' : field with 00716 ! horizontal spatial dim. 00717 ! '-' : no horizontal dim. 00718 !* 0.2 Declarations of local variables 00719 ! 00720 REAL, DIMENSION(SIZE(KFIELD)) :: ZFIELD 00721 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00722 ! 00723 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFN1_OL',0,ZHOOK_HANDLE) 00724 ! 00725 CALL READ_SURFX1_OL(HREC,ZFIELD,KRESP,HCOMMENT,HDIR) 00726 KFIELD = NINT(ZFIELD) 00727 ! 00728 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFN1_OL',1,ZHOOK_HANDLE) 00729 ! 00730 END SUBROUTINE READ_SURFN1_OL 00731 ! 00732 ! ############################################################# 00733 SUBROUTINE READ_SURFC0_OL(HREC,HFIELD,KRESP,HCOMMENT) 00734 ! ############################################################# 00735 ! 00736 !!**** *READC0* - routine to read a STRING 00737 ! 00738 USE MODI_OL_FIND_FILE_READ 00739 USE MODI_ERROR_READ_SURF_OL 00740 ! 00741 USE MODD_SURF_PAR, ONLY: XUNDEF 00742 ! 00743 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00744 USE PARKIND1 ,ONLY : JPRB 00745 ! 00746 IMPLICIT NONE 00747 ! 00748 INCLUDE "netcdf.inc" 00749 ! 00750 !* 0.1 Declarations of arguments 00751 ! 00752 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00753 CHARACTER(LEN=40), INTENT(OUT) :: HFIELD ! the integer scalar to be read 00754 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00755 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00756 ! 00757 !* 0.2 Declarations of local variables 00758 ! 00759 CHARACTER(LEN=100):: YFILE ! filename 00760 CHARACTER(LEN=100):: YFIELD 00761 INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS 00762 INTEGER,DIMENSION(4) :: IRET 00763 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00764 ! 00765 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFC0_OL',0,ZHOOK_HANDLE) 00766 ! 00767 KRESP=0 00768 HCOMMENT = " " 00769 ! 00770 ! 0. find filename 00771 ! ----------------- 00772 CALL OL_FIND_FILE_READ(HREC,IFILE_ID) 00773 ! 00774 IF (IFILE_ID.NE.0) THEN 00775 ! 00776 ! 1. Find id of the variable 00777 !---------------------------- 00778 IRET(1)=NF_INQ_VARID (IFILE_ID,HREC,IVAR_ID) 00779 ! 00780 ! 2. Get variable 00781 !---------------------------- 00782 IRET(2)=NF_GET_VAR_TEXT(IFILE_ID,IVAR_ID,YFIELD) 00783 HFIELD=YFIELD(:LEN_TRIM(YFIELD)) 00784 ! 00785 ENDIF 00786 00787 ! 3. Check for errors 00788 !-------------------- 00789 DO JRET=1,2 00790 IF ((IFILE_ID==0).OR.IRET(JRET).NE.NF_NOERR) THEN 00791 KRESP=1 00792 ENDIF 00793 ENDDO 00794 ! 00795 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(HREC,KRESP) 00796 ! 00797 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFC0_OL',1,ZHOOK_HANDLE) 00798 ! 00799 END SUBROUTINE READ_SURFC0_OL 00800 ! 00801 ! ############################################################# 00802 SUBROUTINE READ_SURFL0_OL(HREC,OFIELD,KRESP,HCOMMENT) 00803 ! ############################################################# 00804 ! 00805 !!**** *READL0* - routine to read a logical 00806 ! 00807 USE MODI_OL_FIND_FILE_READ 00808 USE MODI_ERROR_READ_SURF_OL 00809 ! 00810 USE MODD_SURF_PAR, ONLY: XUNDEF 00811 ! 00812 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00813 USE PARKIND1 ,ONLY : JPRB 00814 ! 00815 IMPLICIT NONE 00816 ! 00817 INCLUDE "netcdf.inc" 00818 ! 00819 !* 0.1 Declarations of arguments 00820 ! 00821 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00822 LOGICAL, INTENT(OUT) :: OFIELD ! array containing the data field 00823 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00824 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00825 ! 00826 !* 0.2 Declarations of local variables 00827 ! 00828 CHARACTER(LEN=1) :: YFIELD ! work array read in the file 00829 CHARACTER(LEN=100) :: YFILE ! Filename 00830 INTEGER :: IVAR_ID,IFILE_ID, JRET 00831 INTEGER,DIMENSION(2) :: IRET 00832 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00833 ! 00834 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFL0_OL',0,ZHOOK_HANDLE) 00835 ! 00836 KRESP=0 00837 HCOMMENT = " " 00838 ! 00839 ! 0. find filename 00840 ! ----------------- 00841 CALL OL_FIND_FILE_READ(HREC,IFILE_ID) 00842 ! 00843 IF (IFILE_ID.NE.0) THEN 00844 ! 00845 ! 1. Find id of the variable 00846 !---------------------------- 00847 IRET(1)=NF_INQ_VARID (IFILE_ID,HREC,IVAR_ID) 00848 ! 00849 ! 2. Get variable 00850 !---------------------------- 00851 IRET(2)=NF_GET_VAR_TEXT(IFILE_ID,IVAR_ID,YFIELD) 00852 ! 00853 IF (YFIELD =='T') OFIELD=.TRUE. 00854 IF (YFIELD =='F') OFIELD=.FALSE. 00855 ! 00856 ENDIF 00857 ! 00858 ! 3. Check for errors 00859 !-------------------- 00860 IF ((IFILE_ID==0).OR.IRET(1).NE.NF_NOERR) THEN 00861 KRESP=1 00862 ENDIF 00863 ! 00864 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(HREC,KRESP) 00865 ! 00866 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFL0_OL',1,ZHOOK_HANDLE) 00867 ! 00868 END SUBROUTINE READ_SURFL0_OL 00869 ! 00870 ! ############################################################# 00871 SUBROUTINE READ_SURFL1_OL(HREC,OFIELD,KRESP,HCOMMENT,HDIR) 00872 ! ############################################################# 00873 ! 00874 !!**** *READL1* - routine to read a logical array 00875 ! 00876 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ 00877 ! 00878 USE MODI_OL_FIND_FILE_READ 00879 USE MODI_ERROR_READ_SURF_OL 00880 ! 00881 USE MODD_SURF_PAR, ONLY: XUNDEF 00882 ! 00883 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00884 USE PARKIND1 ,ONLY : JPRB 00885 ! 00886 IMPLICIT NONE 00887 ! 00888 INCLUDE "netcdf.inc" 00889 ! 00890 #ifndef NOMPI 00891 INCLUDE "mpif.h" 00892 #endif 00893 ! 00894 !* 0.1 Declarations of arguments 00895 ! 00896 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00897 LOGICAL, DIMENSION(:), INTENT(OUT) :: OFIELD ! array containing the data field 00898 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00899 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00900 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00901 ! 'H' : field with 00902 ! horizontal spatial dim. 00903 ! '-' : no horizontal dim. 00904 !* 0.2 Declarations of local variables 00905 ! 00906 CHARACTER(LEN=100) :: YFILE ! Filename 00907 CHARACTER(LEN=1), DIMENSION(:), ALLOCATABLE :: YTAB_1D ! work array read in the file 00908 ! 00909 INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS 00910 INTEGER :: INFOMPI 00911 INTEGER,DIMENSION(1) :: IDIMIDS,IDIMLEN 00912 INTEGER,DIMENSION(2) :: IRET 00913 INTEGER, DIMENSION(:), POINTER :: IMASK ! 1D mask to read only interesting 00914 DOUBLE PRECISION :: XTIME0 00915 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00916 ! 00917 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFL1_OL',0,ZHOOK_HANDLE) 00918 ! 00919 KRESP=0 00920 HCOMMENT = " " 00921 ! 00922 #ifndef NOMPI 00923 XTIME0 = MPI_WTIME() 00924 #endif 00925 ! 00926 IF (NRANK==NPIO) THEN 00927 ! 00928 !$OMP SINGLE 00929 ! 00930 ! 0. find filename 00931 ! ----------------- 00932 CALL OL_FIND_FILE_READ(HREC,IFILE_ID) 00933 ! 00934 IF (IFILE_ID.NE.0) THEN 00935 ! 00936 ! 1. Find id of the variable 00937 !---------------------------- 00938 IRET(1)=NF_INQ_VARID (IFILE_ID,HREC,IVAR_ID) 00939 IRET(1)=NF_INQ_VARNDIMS(IFILE_ID,IVAR_ID,INDIMS) 00940 IRET(1)=NF_INQ_VARDIMID(IFILE_ID,IVAR_ID,IDIMIDS) 00941 DO JDIM=1,INDIMS 00942 JRET=NF_INQ_DIMLEN(IFILE_ID,IDIMIDS(JDIM),IDIMLEN(JDIM)) 00943 ENDDO 00944 ALLOCATE(YTAB_1D(IDIMLEN(1))) 00945 ! 00946 ! 2. Get variable 00947 !---------------------------- 00948 IRET(1)=NF_GET_VAR_TEXT(IFILE_ID,IVAR_ID,YTAB_1D) 00949 ! 00950 DO JRET=1,IDIMLEN(1) 00951 IF (YTAB_1D(JRET) =='T') OFIELD(JRET)=.TRUE. 00952 IF (YTAB_1D(JRET) =='F') OFIELD(JRET)=.FALSE. 00953 ENDDO 00954 ! 00955 ENDIF 00956 ! 00957 ! 3. Check for errors 00958 !-------------------- 00959 DO JRET=1,1 00960 IF ((IFILE_ID==0).OR.IRET(JRET).NE.NF_NOERR) THEN 00961 KRESP=1 00962 ENDIF 00963 ENDDO 00964 ! 00965 DEALLOCATE(YTAB_1D) 00966 ! 00967 !$OMP END SINGLE COPYPRIVATE(OFIELD,HCOMMENT,KRESP) 00968 ! 00969 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(HREC,KRESP) 00970 ! 00971 ENDIF 00972 ! 00973 #ifndef NOMPI 00974 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0) 00975 #endif 00976 ! 00977 IF (NPROC>1) THEN 00978 #ifndef NOMPI 00979 XTIME0 = MPI_WTIME() 00980 !$OMP SINGLE 00981 CALL MPI_BCAST(OFIELD,SIZE(OFIELD),MPI_LOGICAL,NPIO,NCOMM,INFOMPI) 00982 !$OMP END SINGLE COPYPRIVATE(OFIELD) 00983 XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0) 00984 #endif 00985 ENDIF 00986 ! 00987 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFL1_OL',1,ZHOOK_HANDLE) 00988 ! 00989 END SUBROUTINE READ_SURFL1_OL 00990 ! 00991 ! 00992 ! ############################################################# 00993 SUBROUTINE READ_SURFT0_OL(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00994 ! ############################################################# 00995 ! 00996 !!**** *READT0* - routine to read a NETCDF date_time scalar 00997 ! 00998 USE MODI_OL_FIND_FILE_READ 00999 USE MODI_ERROR_READ_SURF_OL 01000 ! 01001 USE MODD_SURF_PAR, ONLY: XUNDEF 01002 ! 01003 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 01004 USE PARKIND1 ,ONLY : JPRB 01005 ! 01006 IMPLICIT NONE 01007 ! 01008 INCLUDE "netcdf.inc" 01009 ! 01010 !* 0.1 Declarations of arguments 01011 ! 01012 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 01013 INTEGER, INTENT(OUT) :: KYEAR ! year 01014 INTEGER, INTENT(OUT) :: KMONTH ! month 01015 INTEGER, INTENT(OUT) :: KDAY ! day 01016 REAL, INTENT(OUT) :: PTIME ! time 01017 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 01018 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 01019 01020 ! 01021 !* 0.2 Declarations of local variables 01022 ! 01023 CHARACTER(LEN=18) :: YRECFM ! Name of the article to be written 01024 CHARACTER(LEN=100) :: YFILE ! Filename 01025 INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS,JWRK 01026 INTEGER, DIMENSION(1) :: IDIMIDS,IDIMLEN 01027 INTEGER, DIMENSION(4) :: IRET 01028 INTEGER, DIMENSION(3) :: ITDATE ! work array read in the file 01029 INTEGER, DIMENSION(:), POINTER :: IMASK ! 1D mask to read only interesting 01030 REAL:: ZTIME 01031 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01032 ! 01033 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFT0_OL',0,ZHOOK_HANDLE) 01034 ! 01035 KRESP=0 01036 HCOMMENT = " " 01037 ! 01038 DO JWRK=1,2 01039 IF (JWRK == 1) THEN 01040 YRECFM=TRIM(HREC)//'-TDATE' 01041 ELSE 01042 YRECFM=TRIM(HREC)//'-TIME' 01043 ENDIF 01044 ! 0. find filename 01045 ! ----------------- 01046 CALL OL_FIND_FILE_READ(YRECFM,IFILE_ID) 01047 ! 01048 IF (IFILE_ID.NE.0) THEN 01049 ! 01050 ! 1. Find id of the variable 01051 !---------------------------- 01052 JRET=NF_INQ_VARID (IFILE_ID,YRECFM,IVAR_ID) 01053 ! 01054 ! 2. Get variable 01055 !---------------------------- 01056 IF (JWRK == 1) THEN 01057 IRET(JWRK)=NF_GET_VAR_INT(IFILE_ID,IVAR_ID,ITDATE) 01058 KYEAR = ITDATE(1) 01059 KMONTH = ITDATE(2) 01060 KDAY = ITDATE(3) 01061 ELSE 01062 IRET(JWRK)=NF_GET_VAR_DOUBLE(IFILE_ID,IVAR_ID,PTIME) 01063 ENDIF 01064 ENDIF 01065 ENDDO 01066 ! 01067 ! 3. Check for errors 01068 !-------------------- 01069 DO JRET=1,2 01070 IF ((IFILE_ID==0).OR.IRET(JRET).NE.NF_NOERR) THEN 01071 KRESP=1 01072 ENDIF 01073 ENDDO 01074 IF (KRESP /=0) CALL ERROR_READ_SURF_OL(YRECFM,KRESP) 01075 ! 01076 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_OL:READ_SURFT0_OL',1,ZHOOK_HANDLE) 01077 ! 01078 END SUBROUTINE READ_SURFT0_OL 01079 ! 01080 END MODULE MODE_READ_SURF_OL
1.8.0
