|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 MODULE MODE_READ_SURF_LFI 00002 ! 00003 !! PURPOSE 00004 !! ------- 00005 ! 00006 ! The purpose of READ_SURF_LFI 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 !! S.Malardel *METEO-FRANCE* 00028 !! 00029 !! MODIFICATIONS 00030 !! ------------- 00031 !! 00032 !! original 01/08/03 00033 !---------------------------------------------------------------------------- 00034 ! 00035 INTERFACE READ_SURF0_LFI 00036 MODULE PROCEDURE READ_SURFX0_LFI 00037 MODULE PROCEDURE READ_SURFN0_LFI 00038 MODULE PROCEDURE READ_SURFL0_LFI 00039 MODULE PROCEDURE READ_SURFC0_LFI 00040 END INTERFACE 00041 INTERFACE READ_SURFN_LFI 00042 MODULE PROCEDURE READ_SURFX1_LFI 00043 MODULE PROCEDURE READ_SURFN1_LFI 00044 MODULE PROCEDURE READ_SURFL1_LFI 00045 MODULE PROCEDURE READ_SURFX2_LFI 00046 END INTERFACE 00047 INTERFACE READ_SURFT_LFI 00048 MODULE PROCEDURE READ_SURFT0_LFI 00049 MODULE PROCEDURE READ_SURFT1_LFI 00050 END INTERFACE 00051 ! 00052 CONTAINS 00053 ! 00054 ! ############################################################# 00055 SUBROUTINE READ_SURFX0_LFI(HREC,PFIELD,KRESP,HCOMMENT) 00056 ! ############################################################# 00057 ! 00058 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI 00059 ! 00060 USE MODI_FMREAD 00061 USE MODI_ERROR_READ_SURF_LFI 00062 ! 00063 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00064 USE PARKIND1 ,ONLY : JPRB 00065 ! 00066 IMPLICIT NONE 00067 ! 00068 !* 0.1 Declarations of arguments 00069 ! 00070 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00071 REAL, INTENT(OUT) :: PFIELD ! the real scalar to be read 00072 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00073 CHARACTER(LEN=100),INTENT(OUT) :: HCOMMENT ! comment 00074 ! 00075 !* 0.2 Declarations of local variables 00076 ! 00077 INTEGER :: IGRID ! position of data on grid 00078 INTEGER :: ILENCH ! length of comment string 00079 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00080 ! 00081 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX0_LFI',0,ZHOOK_HANDLE) 00082 ! 00083 KRESP=0 00084 ! 00085 CALL FMREADX0(CFILE_LFI,HREC,CLUOUT_LFI,1,PFIELD,IGRID,ILENCH,HCOMMENT,KRESP) 00086 ! 00087 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00088 ! 00089 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX0_LFI',1,ZHOOK_HANDLE) 00090 ! 00091 END SUBROUTINE READ_SURFX0_LFI 00092 ! 00093 ! ############################################################# 00094 SUBROUTINE READ_SURFX1_LFI(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00095 ! ############################################################# 00096 ! 00097 !!**** *READX1* - routine to fill a real 1D array for the externalised surface 00098 ! 00099 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ 00100 ! 00101 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI, NMASK, NFULL, & 00102 LMNH_COMPATIBLE 00103 ! 00104 USE MODI_FMREAD 00105 USE MODI_ERROR_READ_SURF_LFI 00106 USE MODI_READ_AND_SEND_MPI 00107 USE MODI_GET_SURF_UNDEF 00108 ! 00109 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00110 USE PARKIND1 ,ONLY : JPRB 00111 ! 00112 IMPLICIT NONE 00113 ! 00114 #ifndef NOMPI 00115 INCLUDE "mpif.h" 00116 #endif 00117 ! 00118 !* 0.1 Declarations of arguments 00119 ! 00120 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00121 REAL, DIMENSION(:), INTENT(OUT) :: PFIELD ! array containing the data field 00122 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00123 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00124 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00125 ! 'H' : field with 00126 ! horizontal spatial dim. 00127 ! '-' : no horizontal dim. 00128 !* 0.2 Declarations of local variables 00129 ! 00130 CHARACTER(LEN=18) :: YREC 00131 REAL :: ZUNDEF ! default value 00132 INTEGER :: IGRID ! position of data on grid 00133 INTEGER :: ILENCH ! length of comment string 00134 INTEGER :: IVERSION, IBUGFIX 00135 INTEGER :: I, INFOMPI 00136 ! 00137 #ifndef NOMPI 00138 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS 00139 #endif 00140 DOUBLE PRECISION :: XTIME0 00141 REAL, DIMENSION(:), ALLOCATABLE :: ZWORK ! work array read in the file 00142 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00143 ! 00144 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX1_LFI',0,ZHOOK_HANDLE) 00145 ! 00146 KRESP=0 00147 ! 00148 #ifndef NOMPI 00149 XTIME0 = MPI_WTIME() 00150 #endif 00151 ! 00152 IF (NRANK==NPIO) THEN 00153 ! 00154 IF (HDIR=='H' .OR. HDIR=='A') THEN 00155 ALLOCATE(ZWORK(NFULL)) 00156 ELSE 00157 ALLOCATE(ZWORK(SIZE(PFIELD))) 00158 ENDIF 00159 ! 00160 !$OMP SINGLE 00161 ! 00162 YREC = HREC 00163 ! 00164 !--------------------------------------------------------------------------- 00165 !* patch to read some test files done before version 3.5 00166 ! this should be removed once all tests with reading lfi files done with 923 00167 ! configuration (with these early versions) are finished. 00168 ! 00169 IF (HREC(1:2)=='D_') THEN 00170 CALL FMREADN0(CFILE_LFI,'VERSION',CLUOUT_LFI,1,IVERSION,IGRID,ILENCH,HCOMMENT,KRESP) 00171 CALL FMREADN0(CFILE_LFI,'BUG',CLUOUT_LFI,1,IBUGFIX,IGRID,ILENCH,HCOMMENT,KRESP) 00172 IF (IVERSION<=2 .OR. (IVERSION==3 .AND. IBUGFIX<=5)) YREC = 'DATA_'//HREC(3:12) 00173 END IF 00174 !--------------------------------------------------------------------------- 00175 ! 00176 IF (HDIR=='H' .OR. HDIR=='A') THEN 00177 IF (.NOT. LMNH_COMPATIBLE) THEN 00178 CALL FMREADX1(CFILE_LFI,YREC,CLUOUT_LFI,NFULL,ZWORK,IGRID,ILENCH,HCOMMENT,KRESP) 00179 ELSE 00180 CALL READ_IN_LFI_X1_FOR_MNH(YREC,ZWORK,KRESP,HCOMMENT,HDIR) 00181 END IF 00182 ELSE 00183 CALL FMREADX1(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(ZWORK),ZWORK,IGRID,ILENCH,HCOMMENT,KRESP) 00184 END IF 00185 CALL ERROR_READ_SURF_LFI(YREC,KRESP) 00186 ! 00187 !$OMP END SINGLE COPYPRIVATE(ZWORK,HCOMMENT,KRESP) 00188 ! 00189 ELSE 00190 ALLOCATE(ZWORK(0)) 00191 ENDIF 00192 ! 00193 #ifndef NOMPI 00194 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0) 00195 #endif 00196 ! 00197 IF (HDIR=='A') THEN ! no distribution on other tasks 00198 IF ( NRANK==NPIO ) THEN 00199 #ifndef NOMPI 00200 XTIME0 = MPI_WTIME() 00201 #endif 00202 PFIELD(:) = ZWORK(1:SIZE(PFIELD)) 00203 #ifndef NOMPI 00204 XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0) 00205 #endif 00206 ENDIF 00207 ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks 00208 !$OMP SINGLE 00209 PFIELD(:) = ZWORK(1:SIZE(PFIELD)) 00210 IF (NPROC>1) THEN 00211 #ifndef NOMPI 00212 XTIME0 = MPI_WTIME() 00213 CALL MPI_BCAST(PFIELD,SIZE(PFIELD)*KIND(PFIELD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI) 00214 XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0) 00215 #endif 00216 ENDIF 00217 !$OMP END SINGLE COPYPRIVATE(PFIELD) 00218 ELSE 00219 CALL READ_AND_SEND_MPI(ZWORK,PFIELD,NMASK) 00220 ENDIF 00221 ! 00222 DEALLOCATE(ZWORK) 00223 ! 00224 ! 00225 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX1_LFI',1,ZHOOK_HANDLE) 00226 ! 00227 CONTAINS 00228 ! 00229 ! ############################################################# 00230 SUBROUTINE READ_IN_LFI_X1_FOR_MNH(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00231 ! ############################################################# 00232 ! 00233 !!**** * - routine to fill a read 2D array for the externalised surface 00234 ! 00235 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI, & 00236 NIU, NIB, NIE, NJU, NJB, NJE 00237 ! 00238 USE MODI_FMREAD 00239 USE MODI_ERROR_READ_SURF_LFI 00240 ! 00241 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00242 USE PARKIND1 ,ONLY : JPRB 00243 ! 00244 IMPLICIT NONE 00245 ! 00246 !* 0.1 Declarations of arguments 00247 ! 00248 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00249 REAL, DIMENSION(:), INTENT(OUT):: PFIELD ! array containing the data field 00250 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00251 CHARACTER(LEN=100), INTENT(OUT):: HCOMMENT ! comment string 00252 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00253 ! 'H' : field with 00254 ! horizontal spatial dim. 00255 ! '-' : no horizontal dim. 00256 ! 00257 !* 0.2 Declarations of local variables 00258 ! 00259 CHARACTER(LEN=4) :: YREC1D 00260 INTEGER :: JI, JJ 00261 INTEGER :: ILEN 00262 INTEGER :: IGRID, ILENCH 00263 REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1D! 1D work array read in the file 00264 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D ! work array read in a MNH file 00265 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00266 ! 00267 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX1_LFI:READ_IN_LFI_X1_FOR_MNH',0,ZHOOK_HANDLE) 00268 ! 00269 ALLOCATE(ZWORK2D(NIU,NJU)) 00270 ZWORK2D(:,:) = 999. 00271 ! 00272 IF (HREC=='XX ' .OR. HREC=='DX ') THEN 00273 ALLOCATE(ZWORK1D(NIU)) 00274 YREC1D = 'XHAT' 00275 ILEN = NIU 00276 ELSEIF (HREC=='YY ' .OR. HREC=='DY ') THEN 00277 ALLOCATE(ZWORK1D(NJU)) 00278 YREC1D = 'YHAT' 00279 ILEN = NJU 00280 ELSEIF (NJB==NJE) THEN 00281 ALLOCATE(ZWORK1D(NIU)) 00282 ZWORK1D(:) = 999. 00283 ELSEIF (NIB==NIE) THEN 00284 ALLOCATE(ZWORK1D(NJU)) 00285 ZWORK1D(:) = 999. 00286 ENDIF 00287 ! 00288 IF (HREC=='XX' .OR. HREC=='YY'.OR. HREC=='DX' .OR. HREC=='DY') THEN 00289 ! 00290 CALL FMREADX1(CFILE_LFI,YREC1D,CLUOUT_LFI,ILEN,ZWORK1D,IGRID,ILENCH,HCOMMENT,KRESP) 00291 CALL ERROR_READ_SURF_LFI(YREC1D,KRESP) 00292 ! 00293 SELECT CASE(HREC) 00294 CASE('XX ') 00295 DO JJ = 1,SIZE(ZWORK2D,2) 00296 ZWORK2D(NIB:NIE,JJ) = 0.5 * ZWORK1D(NIB:NIE) + 0.5 * ZWORK1D(NIB+1:NIE+1) 00297 END DO 00298 CASE('DX ') 00299 DO JJ = 1,SIZE(ZWORK2D,2) 00300 ZWORK2D(NIB:NIE,JJ) = - ZWORK1D(NIB:NIE) + ZWORK1D(NIB+1:NIE+1) 00301 END DO 00302 CASE('YY ') 00303 DO JI = 1,SIZE(ZWORK2D,1) 00304 ZWORK2D(JI,NJB:NJE) = 0.5 * ZWORK1D(NJB:NJE) + 0.5 * ZWORK1D(NJB+1:NJE+1) 00305 END DO 00306 CASE('DY ') 00307 DO JI = 1,SIZE(ZWORK2D,1) 00308 ZWORK2D(JI,NJB:NJE) = - ZWORK1D(NJB:NJE) + ZWORK1D(NJB+1:NJE+1) 00309 END DO 00310 END SELECT 00311 ! 00312 DEALLOCATE(ZWORK1D) 00313 ! 00314 ELSEIF (NJB==NJE) THEN 00315 ! 00316 CALL FMREADX1(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(ZWORK1D),ZWORK1D,IGRID,ILENCH,HCOMMENT,KRESP) 00317 DO JJ = 1,SIZE(ZWORK2D,2) 00318 ZWORK2D(NIB:NIE,JJ) = ZWORK1D(NIB:NIE) 00319 END DO 00320 ! 00321 DEALLOCATE(ZWORK1D) 00322 ! 00323 ELSEIF (NIB==NIE) THEN 00324 ! 00325 CALL FMREADX1(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(ZWORK1D),ZWORK1D,IGRID,ILENCH,HCOMMENT,KRESP) 00326 DO JI = 1,SIZE(ZWORK2D,1) 00327 ZWORK2D(JI,NJB:NJE) = ZWORK1D(NJB:NJE) 00328 END DO 00329 ! 00330 DEALLOCATE(ZWORK1D) 00331 ! 00332 ELSE 00333 ! 00334 CALL FMREADX2(CFILE_LFI,HREC,CLUOUT_LFI,SIZE(ZWORK2D),ZWORK2D,IGRID,ILENCH,HCOMMENT,KRESP) 00335 ! 00336 ENDIF 00337 ! 00338 DO JJ=1,NJE-NJB+1 00339 DO JI=1,NIE-NIB+1 00340 PFIELD(JI+(NIE-NIB+1)*(JJ-1)) = ZWORK2D(NIB+JI-1,NJB+JJ-1) 00341 END DO 00342 END DO 00343 ! 00344 DEALLOCATE(ZWORK2D) 00345 ! 00346 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00347 ! 00348 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX1_LFI:READ_IN_LFI_X1_FOR_MNH',1,ZHOOK_HANDLE) 00349 ! 00350 END SUBROUTINE READ_IN_LFI_X1_FOR_MNH 00351 ! 00352 END SUBROUTINE READ_SURFX1_LFI 00353 ! 00354 ! ############################################################# 00355 SUBROUTINE READ_SURFX2_LFI(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00356 ! ############################################################# 00357 ! 00358 !!**** *READX2* - routine to fill a real 2D array for the externalised surface 00359 ! 00360 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ 00361 ! 00362 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI, NMASK, NFULL, & 00363 LMNH_COMPATIBLE 00364 ! 00365 USE MODI_FMREAD 00366 USE MODI_ERROR_READ_SURF_LFI 00367 USE MODI_READ_AND_SEND_MPI 00368 USE MODI_GET_SURF_UNDEF 00369 ! 00370 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00371 USE PARKIND1 ,ONLY : JPRB 00372 ! 00373 IMPLICIT NONE 00374 ! 00375 #ifndef NOMPI 00376 INCLUDE "mpif.h" 00377 #endif 00378 ! 00379 !* 0.1 Declarations of arguments 00380 ! 00381 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00382 REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD ! array containing the data field 00383 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00384 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00385 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00386 ! 'H' : field with 00387 ! horizontal spatial dim. 00388 ! '-' : no horizontal dim. 00389 !* 0.2 Declarations of local variables 00390 ! 00391 CHARACTER(LEN=16) :: YREC 00392 REAL :: ZUNDEF ! default value 00393 INTEGER :: IGRID ! position of data on grid 00394 INTEGER :: ILENCH ! length of comment string 00395 INTEGER :: IVERSION, IBUGFIX 00396 INTEGER :: I, INFOMPI 00397 ! 00398 #ifndef NOMPI 00399 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS 00400 #endif 00401 DOUBLE PRECISION :: XTIME0 00402 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! work array read in the file 00403 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00404 ! 00405 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX2_LFI',0,ZHOOK_HANDLE) 00406 ! 00407 KRESP=0 00408 ! 00409 #ifndef NOMPI 00410 XTIME0 = MPI_WTIME() 00411 #endif 00412 ! 00413 IF (NRANK==NPIO) THEN 00414 ! 00415 IF (HDIR=='H' .OR. HDIR=='A') THEN 00416 ALLOCATE(ZWORK(NFULL,SIZE(PFIELD,2))) 00417 ELSE 00418 ALLOCATE(ZWORK(SIZE(PFIELD,1),SIZE(PFIELD,2))) 00419 ENDIF 00420 ! 00421 !$OMP SINGLE 00422 ! 00423 YREC = HREC 00424 ! 00425 !--------------------------------------------------------------------------- 00426 !* patch to read some test files done before version 3.5 00427 ! this should be removed once all tests with reading lfi files done with 923 00428 ! configuration (with these early versions) are finished. 00429 ! 00430 IF (HREC(1:2)=='D_') THEN 00431 CALL FMREADN0(CFILE_LFI,'VERSION',CLUOUT_LFI,1,IVERSION,IGRID,ILENCH,HCOMMENT,KRESP) 00432 CALL FMREADN0(CFILE_LFI,'BUG',CLUOUT_LFI,1,IBUGFIX,IGRID,ILENCH,HCOMMENT,KRESP) 00433 IF (IVERSION<=2 .OR. (IVERSION==3 .AND. IBUGFIX<=5)) YREC = 'DATA_'//HREC(3:12) 00434 IF (YREC(13:15)=='SOI') YREC=YREC(1:15)//'L' 00435 IF (YREC(12:14)=='SOI') YREC=YREC(1:14)//'L' 00436 END IF 00437 !--------------------------------------------------------------------------- 00438 ! 00439 IF (HDIR=='H' .OR. HDIR=='A') THEN 00440 IF (.NOT. LMNH_COMPATIBLE) THEN 00441 CALL FMREADX2(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(ZWORK),ZWORK(:,:),IGRID,ILENCH,HCOMMENT,KRESP) 00442 ELSE 00443 CALL READ_IN_LFI_X2_FOR_MNH(YREC,ZWORK,KRESP,HCOMMENT,HDIR) 00444 END IF 00445 ELSE 00446 CALL FMREADX2(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(ZWORK),ZWORK(:,:),IGRID,ILENCH,HCOMMENT,KRESP) 00447 END IF 00448 CALL ERROR_READ_SURF_LFI(YREC,KRESP) 00449 ! 00450 !$OMP END SINGLE COPYPRIVATE(ZWORK,HCOMMENT,KRESP) 00451 ! 00452 ELSE 00453 ALLOCATE(ZWORK(0,0)) 00454 ENDIF 00455 ! 00456 #ifndef NOMPI 00457 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0) 00458 #endif 00459 ! 00460 IF (HDIR=='A') THEN ! no distribution on other tasks 00461 IF ( NRANK==NPIO ) THEN 00462 #ifndef NOMPI 00463 XTIME0 = MPI_WTIME() 00464 #endif 00465 PFIELD(:,:) = ZWORK(1:SIZE(PFIELD,1),:) 00466 #ifndef NOMPI 00467 XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0) 00468 #endif 00469 ENDIF 00470 ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks 00471 !$OMP SINGLE 00472 PFIELD(:,:) = ZWORK(1:SIZE(PFIELD,1),:) 00473 IF (NPROC>1) THEN 00474 #ifndef NOMPI 00475 XTIME0 = MPI_WTIME() 00476 CALL MPI_BCAST(PFIELD,SIZE(PFIELD)*KIND(PFIELD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI) 00477 XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0) 00478 #endif 00479 ENDIF 00480 !$OMP END SINGLE COPYPRIVATE(PFIELD) 00481 ELSE 00482 CALL READ_AND_SEND_MPI(ZWORK,PFIELD,NMASK) 00483 ENDIF 00484 ! 00485 DEALLOCATE(ZWORK) 00486 ! 00487 IF (HDIR=='H' .OR. HDIR=='A') THEN 00488 CALL GET_SURF_UNDEF(ZUNDEF) 00489 WHERE(PFIELD==999.) PFIELD=ZUNDEF 00490 ENDIF 00491 ! 00492 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX2_LFI',1,ZHOOK_HANDLE) 00493 ! 00494 CONTAINS 00495 ! 00496 ! ############################################################# 00497 SUBROUTINE READ_IN_LFI_X2_FOR_MNH(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00498 ! ############################################################# 00499 ! 00500 !!**** * - routine to fill a read 2D array for the externalised surface 00501 ! 00502 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI, & 00503 NIU, NIB, NIE, NJU, NJB, NJE 00504 ! 00505 USE MODI_FMREAD 00506 USE MODI_ERROR_READ_SURF_LFI 00507 ! 00508 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00509 USE PARKIND1 ,ONLY : JPRB 00510 ! 00511 IMPLICIT NONE 00512 ! 00513 !* 0.1 Declarations of arguments 00514 ! 00515 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00516 REAL, DIMENSION(:,:), INTENT(OUT):: PFIELD ! array containing the data field 00517 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00518 CHARACTER(LEN=100), INTENT(OUT):: HCOMMENT ! comment string 00519 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00520 ! 'H' : field with 00521 ! horizontal spatial dim. 00522 ! '-' : no horizontal dim. 00523 !* 0.2 Declarations of local variables 00524 ! 00525 INTEGER :: JI, JJ 00526 INTEGER :: IGRID, ILENCH 00527 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D ! work array read in a MNH file 00528 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D 00529 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00530 ! 00531 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX2_LFI:READ_IN_LFI_X2_FOR_MNH',0,ZHOOK_HANDLE) 00532 ! 00533 ALLOCATE(ZWORK3D(NIU,NJU,SIZE(PFIELD,2))) 00534 ZWORK3D(:,:,:) = 999. 00535 ! 00536 IF (NJB==NJE) THEN 00537 ALLOCATE(ZWORK2D(NIU,SIZE(PFIELD,2))) 00538 ZWORK2D(:,:) = 999. 00539 ELSEIF (NIB==NIE) THEN 00540 ALLOCATE(ZWORK2D(NJU,SIZE(PFIELD,2))) 00541 ZWORK2D(:,:) = 999. 00542 ENDIF 00543 ! 00544 IF (NJB==NJE) THEN 00545 ! 00546 CALL FMREADX2(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(ZWORK2D),ZWORK2D,IGRID,ILENCH,HCOMMENT,KRESP) 00547 DO JJ = 1,SIZE(ZWORK3D,2) 00548 ZWORK3D(NIB:NIE,JJ,:) = ZWORK2D(NIB:NIE,:) 00549 END DO 00550 ! 00551 DEALLOCATE(ZWORK2D) 00552 ! 00553 ELSEIF (NIB==NIE) THEN 00554 ! 00555 CALL FMREADX2(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(ZWORK2D),ZWORK2D,IGRID,ILENCH,HCOMMENT,KRESP) 00556 DO JI = 1,SIZE(ZWORK3D,1) 00557 ZWORK3D(JI,NIB:NIE,:) = ZWORK2D(NJB:NJE,:) 00558 END DO 00559 ! 00560 DEALLOCATE(ZWORK2D) 00561 ! 00562 ELSE 00563 ! 00564 CALL FMREADX3(CFILE_LFI,HREC,CLUOUT_LFI,SIZE(ZWORK3D),ZWORK3D,IGRID,ILENCH,HCOMMENT,KRESP) 00565 ! 00566 ENDIF 00567 ! 00568 DO JJ=1,NJE-NJB+1 00569 DO JI=1,NIE-NIB+1 00570 PFIELD(JI+(NIE-NIB+1)*(JJ-1),:) = ZWORK3D(NIB+JI-1,NJB+JJ-1,:) 00571 END DO 00572 END DO 00573 DEALLOCATE(ZWORK3D) 00574 ! 00575 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00576 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFX2_LFI:READ_IN_LFI_X2_FOR_MNH',1,ZHOOK_HANDLE) 00577 ! 00578 END SUBROUTINE READ_IN_LFI_X2_FOR_MNH 00579 ! 00580 END SUBROUTINE READ_SURFX2_LFI 00581 ! 00582 ! ############################################################# 00583 SUBROUTINE READ_SURFN0_LFI(HREC,KFIELD,KRESP,HCOMMENT) 00584 ! ############################################################# 00585 ! 00586 !!**** *READN0* - routine to read an integer 00587 !! B. Decharme 07/2011 : Grdid dimension only read in pgd file 00588 ! 00589 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI, CFILEPGD_LFI, & 00590 LMNH_COMPATIBLE, NIU, NIB, NIE, NJU, NJB, NJE 00591 ! 00592 USE MODD_SURFEX_OMP, ONLY : NBLOCK 00593 ! 00594 USE MODI_FMREAD 00595 USE MODI_ERROR_READ_SURF_LFI 00596 ! 00597 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00598 USE PARKIND1 ,ONLY : JPRB 00599 ! 00600 IMPLICIT NONE 00601 ! 00602 !* 0.1 Declarations of arguments 00603 ! 00604 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00605 INTEGER, INTENT(OUT) :: KFIELD ! the integer to be read 00606 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00607 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00608 ! 00609 !* 0.2 Declarations of local variables 00610 ! 00611 CHARACTER(LEN=40) :: YGRID 00612 INTEGER :: IGRID ! position of data on grid 00613 INTEGER :: ILENCH ! length of comment string 00614 INTEGER :: IIMAX, IJMAX 00615 INTEGER :: INB ! number of articles in the file 00616 INTEGER :: IRESP 00617 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00618 ! 00619 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFN0_LFI',0,ZHOOK_HANDLE) 00620 ! 00621 KRESP=0 00622 ! 00623 CALL FMREADN0(CFILE_LFI,HREC,CLUOUT_LFI,1,KFIELD,IGRID,ILENCH,HCOMMENT,KRESP) 00624 ! 00625 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00626 ! 00627 !* tests compatibility with MesoNH files 00628 ! 00629 IF (HREC/='DIM_FULL' .AND. LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFN0_LFI',1,ZHOOK_HANDLE) 00630 IF (HREC/='DIM_FULL') RETURN 00631 ! 00632 !----------------------------------------------------------------------------------------------------- 00633 ! READ PGD FILE 00634 !----------------------------------------------------------------------------------------------------- 00635 ! 00636 IF (CFILE_LFI/=CFILEPGD_LFI) THEN 00637 CALL FMOPEN(CFILEPGD_LFI,'OLD',CLUOUT_LFI,0,1,1,INB,IRESP) 00638 ENDIF 00639 ! 00640 CALL FMREADC0(CFILEPGD_LFI,'GRID_TYPE ',CLUOUT_LFI,1,YGRID,IGRID,ILENCH,HCOMMENT,KRESP) 00641 CALL ERROR_READ_SURF_LFI('GRID_TYPE ',KRESP) 00642 LMNH_COMPATIBLE = (YGRID=="CARTESIAN " .OR. YGRID=="CONF PROJ ") 00643 ! 00644 IF (LMNH_COMPATIBLE) THEN 00645 CALL FMREADN0(CFILEPGD_LFI,'IMAX',CLUOUT_LFI,1,IIMAX,IGRID,ILENCH,HCOMMENT,KRESP) 00646 CALL ERROR_READ_SURF_LFI('IMAX',KRESP) 00647 NIU = IIMAX+2 00648 NIB = 2 00649 NIE = IIMAX+1 00650 CALL FMREADN0(CFILEPGD_LFI,'JMAX',CLUOUT_LFI,1,IJMAX,IGRID,ILENCH,HCOMMENT,KRESP) 00651 CALL ERROR_READ_SURF_LFI('JMAX',KRESP) 00652 NJU = IJMAX+2 00653 NJB = 2 00654 NJE = IJMAX+1 00655 END IF 00656 ! 00657 IF(CFILE_LFI/=CFILEPGD_LFI)THEN 00658 CALL FMCLOS(CFILEPGD_LFI,'KEEP',CLUOUT_LFI,IRESP) 00659 ENDIF 00660 ! 00661 !----------------------------------------------------------------------------------------------------- 00662 ! END READ PGD FILE 00663 !----------------------------------------------------------------------------------------------------- 00664 ! 00665 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFN0_LFI',1,ZHOOK_HANDLE) 00666 ! 00667 END SUBROUTINE READ_SURFN0_LFI 00668 ! 00669 ! ############################################################# 00670 SUBROUTINE READ_SURFN1_LFI(HREC,KFIELD,KRESP,HCOMMENT,HDIR) 00671 ! ############################################################# 00672 ! 00673 !!**** *READN0* - routine to read an integer 00674 ! 00675 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ 00676 ! 00677 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI, NMASK, NFULL 00678 ! 00679 USE MODI_FMREAD 00680 USE MODI_ERROR_READ_SURF_LFI 00681 USE MODI_READ_AND_SEND_MPI 00682 ! 00683 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00684 USE PARKIND1 ,ONLY : JPRB 00685 ! 00686 IMPLICIT NONE 00687 ! 00688 #ifndef NOMPI 00689 INCLUDE "mpif.h" 00690 #endif 00691 ! 00692 !* 0.1 Declarations of arguments 00693 ! 00694 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00695 INTEGER, DIMENSION(:), INTENT(OUT) :: KFIELD ! the integer to be read 00696 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00697 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00698 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00699 ! 'H' : field with 00700 ! horizontal spatial dim. 00701 ! '-' : no horizontal dim. 00702 !* 0.2 Declarations of local variables 00703 ! 00704 INTEGER :: IGRID ! position of data on grid 00705 INTEGER :: ILENCH ! length of comment string 00706 INTEGER :: I, INFOMPI 00707 ! 00708 #ifndef NOMPI 00709 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS 00710 #endif 00711 INTEGER, DIMENSION(:), ALLOCATABLE :: IWORK ! work array read in the file 00712 DOUBLE PRECISION :: XTIME0 00713 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00714 ! 00715 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFN1_LFI',0,ZHOOK_HANDLE) 00716 ! 00717 KRESP=0 00718 ! 00719 #ifndef NOMPI 00720 XTIME0 = MPI_WTIME() 00721 #endif 00722 ! 00723 IF (NRANK==NPIO) THEN 00724 ! 00725 IF (HDIR=='H' .OR. HDIR=='A') THEN 00726 ALLOCATE(IWORK(NFULL)) 00727 ELSE 00728 ALLOCATE(IWORK(SIZE(KFIELD))) 00729 ENDIF 00730 ! 00731 !$OMP SINGLE 00732 ! 00733 IF (HDIR=='H' .OR. HDIR=='A') THEN 00734 CALL FMREADN1(CFILE_LFI,HREC,CLUOUT_LFI,NFULL,IWORK,IGRID,ILENCH,HCOMMENT,KRESP) 00735 ELSE 00736 CALL FMREADN1(CFILE_LFI,HREC,CLUOUT_LFI,SIZE(IWORK),IWORK(:),IGRID,ILENCH,HCOMMENT,KRESP) 00737 END IF 00738 ! 00739 !$OMP END SINGLE COPYPRIVATE(IWORK,HCOMMENT,KRESP) 00740 ! 00741 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00742 ! 00743 ENDIF 00744 ! 00745 #ifndef NOMPI 00746 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0) 00747 #endif 00748 ! 00749 IF (HDIR=='A') THEN ! no distribution on other tasks 00750 IF ( NRANK==NPIO ) THEN 00751 #ifndef NOMPI 00752 XTIME0 = MPI_WTIME() 00753 #endif 00754 KFIELD(:) = IWORK(1:SIZE(KFIELD)) 00755 #ifndef NOMPI 00756 XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0) 00757 #endif 00758 ENDIF 00759 ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks 00760 !$OMP SINGLE 00761 KFIELD(:) = IWORK(1:SIZE(KFIELD)) 00762 IF (NPROC>1) THEN 00763 #ifndef NOMPI 00764 XTIME0 = MPI_WTIME() 00765 CALL MPI_BCAST(KFIELD,SIZE(KFIELD)*KIND(KFIELD)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI) 00766 XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0) 00767 #endif 00768 ENDIF 00769 !$OMP END SINGLE COPYPRIVATE(KFIELD) 00770 ELSE 00771 CALL READ_AND_SEND_MPI(IWORK,KFIELD,NMASK) 00772 ENDIF 00773 ! 00774 !$OMP SINGLE 00775 DEALLOCATE(IWORK) 00776 !$OMP END SINGLE 00777 ! 00778 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFN1_LFI',1,ZHOOK_HANDLE) 00779 ! 00780 END SUBROUTINE READ_SURFN1_LFI 00781 ! 00782 ! ############################################################# 00783 SUBROUTINE READ_SURFC0_LFI(HREC,HFIELD,KRESP,HCOMMENT) 00784 ! ############################################################# 00785 ! 00786 !!**** *READC0* - routine to read a character 00787 ! 00788 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI 00789 ! 00790 USE MODI_FMREAD 00791 USE MODI_ERROR_READ_SURF_LFI 00792 ! 00793 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00794 USE PARKIND1 ,ONLY : JPRB 00795 ! 00796 IMPLICIT NONE 00797 ! 00798 !* 0.1 Declarations of arguments 00799 ! 00800 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00801 CHARACTER(LEN=40), INTENT(OUT) :: HFIELD ! the integer to be read 00802 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00803 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00804 ! 00805 !* 0.2 Declarations of local variables 00806 ! 00807 INTEGER :: IGRID ! position of data on grid 00808 INTEGER :: ILENCH ! length of comment string 00809 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00810 ! 00811 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFC0_LFI',0,ZHOOK_HANDLE) 00812 ! 00813 KRESP=0 00814 ! 00815 CALL FMREADC0(CFILE_LFI,HREC,CLUOUT_LFI,1,HFIELD,IGRID,ILENCH,HCOMMENT,KRESP) 00816 ! 00817 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00818 ! 00819 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFC0_LFI',1,ZHOOK_HANDLE) 00820 ! 00821 END SUBROUTINE READ_SURFC0_LFI 00822 ! 00823 ! ############################################################# 00824 SUBROUTINE READ_SURFL0_LFI(HREC,OFIELD,KRESP,HCOMMENT) 00825 ! ############################################################# 00826 ! 00827 !!**** *READL0* - routine to read a logical 00828 ! 00829 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI 00830 ! 00831 USE MODI_FMREAD 00832 USE MODI_ERROR_READ_SURF_LFI 00833 ! 00834 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00835 USE PARKIND1 ,ONLY : JPRB 00836 ! 00837 IMPLICIT NONE 00838 ! 00839 !* 0.1 Declarations of arguments 00840 ! 00841 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00842 LOGICAL, INTENT(OUT) :: OFIELD ! array containing the data field 00843 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00844 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00845 ! 00846 !* 0.2 Declarations of local variables 00847 ! 00848 INTEGER :: IGRID ! position of data on grid 00849 INTEGER :: ILENCH ! length of comment string 00850 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00851 ! 00852 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFL0_LFI',0,ZHOOK_HANDLE) 00853 ! 00854 KRESP=0 00855 ! 00856 CALL FMREADL0(CFILE_LFI,HREC,CLUOUT_LFI,1,OFIELD,IGRID,ILENCH,HCOMMENT,KRESP) 00857 ! 00858 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00859 ! 00860 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFL0_LFI',1,ZHOOK_HANDLE) 00861 ! 00862 END SUBROUTINE READ_SURFL0_LFI 00863 ! 00864 ! ############################################################# 00865 SUBROUTINE READ_SURFL1_LFI(HREC,OFIELD,KRESP,HCOMMENT,HDIR) 00866 ! ############################################################# 00867 ! 00868 !!**** *READL1* - routine to read a logical array 00869 ! 00870 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ 00871 ! 00872 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI 00873 ! 00874 USE MODI_FMREAD 00875 USE MODI_ERROR_READ_SURF_LFI 00876 USE MODI_ABOR1_SFX 00877 USE MODI_GET_LUOUT 00878 ! 00879 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00880 USE PARKIND1 ,ONLY : JPRB 00881 ! 00882 IMPLICIT NONE 00883 ! 00884 #ifndef NOMPI 00885 INCLUDE "mpif.h" 00886 #endif 00887 ! 00888 !* 0.1 Declarations of arguments 00889 ! 00890 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00891 LOGICAL, DIMENSION(:), INTENT(OUT) :: OFIELD ! array containing the data field 00892 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00893 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00894 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00895 ! 'H' : field with 00896 ! horizontal spatial dim. 00897 ! '-' : no horizontal dim. 00898 !* 0.2 Declarations of local variables 00899 ! 00900 INTEGER :: ILUOUT 00901 INTEGER :: IGRID ! position of data on grid 00902 INTEGER :: ILENCH ! length of comment string 00903 INTEGER :: INFOMPI 00904 DOUBLE PRECISION :: XTIME0 00905 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00906 ! 00907 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFL1_LFI',0,ZHOOK_HANDLE) 00908 ! 00909 KRESP=0 00910 ! 00911 #ifndef NOMPI 00912 XTIME0 = MPI_WTIME() 00913 #endif 00914 ! 00915 IF (NRANK==NPIO) THEN 00916 ! 00917 !$OMP SINGLE 00918 ! 00919 IF (HDIR=='H') THEN 00920 CALL GET_LUOUT('LFI ',ILUOUT) 00921 WRITE(ILUOUT,*) 'Error: 1D logical vector for reading on an horizontal grid:' 00922 WRITE(ILUOUT,*) 'this option is not coded in READ_SURFL1_LFI' 00923 CALL ABOR1_SFX('MODE_READ_SURF_LFI: 1D LOGICAL VECTOR FOR READING NOT CODED IN READ_SURFL1_LFI') 00924 END IF 00925 ! 00926 CALL FMREADL1(CFILE_LFI,HREC,CLUOUT_LFI,SIZE(OFIELD),OFIELD,IGRID,ILENCH,HCOMMENT,KRESP) 00927 ! 00928 !$OMP END SINGLE COPYPRIVATE(OFIELD,HCOMMENT,KRESP) 00929 ! 00930 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00931 ! 00932 ENDIF 00933 ! 00934 #ifndef NOMPI 00935 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0) 00936 #endif 00937 ! 00938 IF (NPROC>1 .AND. HDIR/='A') THEN 00939 #ifndef NOMPI 00940 XTIME0 = MPI_WTIME() 00941 !$OMP SINGLE 00942 CALL MPI_BCAST(OFIELD,SIZE(OFIELD),MPI_LOGICAL,NPIO,NCOMM,INFOMPI) 00943 !$OMP END SINGLE COPYPRIVATE(OFIELD) 00944 XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0) 00945 #endif 00946 ENDIF 00947 ! 00948 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFL1_LFI',1,ZHOOK_HANDLE) 00949 ! 00950 END SUBROUTINE READ_SURFL1_LFI 00951 ! 00952 ! ############################################################# 00953 SUBROUTINE READ_SURFT0_LFI(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00954 ! ############################################################# 00955 ! 00956 !!**** *READT0* - routine to read a date 00957 ! 00958 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI 00959 ! 00960 USE MODI_FMREAD 00961 USE MODI_ERROR_READ_SURF_LFI 00962 ! 00963 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00964 USE PARKIND1 ,ONLY : JPRB 00965 ! 00966 IMPLICIT NONE 00967 ! 00968 !* 0.1 Declarations of arguments 00969 ! 00970 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 00971 INTEGER, INTENT(OUT) :: KYEAR ! year 00972 INTEGER, INTENT(OUT) :: KMONTH ! month 00973 INTEGER, INTENT(OUT) :: KDAY ! day 00974 REAL, INTENT(OUT) :: PTIME ! year 00975 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00976 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 00977 00978 !* 0.2 Declarations of local variables 00979 ! 00980 CHARACTER(LEN=18) :: YREC ! Name of the article to be read 00981 INTEGER, DIMENSION(3) :: ITDATE 00982 ! 00983 INTEGER :: IGRID ! position of data on grid 00984 INTEGER :: ILENCH ! length of comment string 00985 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00986 ! 00987 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFT0_LFI',0,ZHOOK_HANDLE) 00988 ! 00989 KRESP=0 00990 ! 00991 YREC=TRIM(HREC)//'%TDATE' 00992 CALL FMREADN1(CFILE_LFI,YREC,CLUOUT_LFI,3,ITDATE,IGRID,ILENCH,HCOMMENT,KRESP) 00993 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00994 ! 00995 YREC=TRIM(HREC)//'%TIME' 00996 CALL FMREADX0(CFILE_LFI,YREC,CLUOUT_LFI,1,PTIME,IGRID,ILENCH,HCOMMENT,KRESP) 00997 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 00998 ! 00999 KYEAR = ITDATE(1) 01000 KMONTH = ITDATE(2) 01001 KDAY = ITDATE(3) 01002 ! 01003 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFT0_LFI',1,ZHOOK_HANDLE) 01004 ! 01005 END SUBROUTINE READ_SURFT0_LFI 01006 ! 01007 ! ############################################################# 01008 SUBROUTINE READ_SURFT1_LFI(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 01009 ! ############################################################# 01010 ! 01011 !!**** *READT0* - routine to read a date 01012 ! 01013 USE MODD_IO_SURF_LFI, ONLY : CFILE_LFI, CLUOUT_LFI 01014 ! 01015 USE MODI_FMREAD 01016 USE MODI_ERROR_READ_SURF_LFI 01017 ! 01018 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 01019 USE PARKIND1 ,ONLY : JPRB 01020 ! 01021 IMPLICIT NONE 01022 ! 01023 !* 0.1 Declarations of arguments 01024 ! 01025 CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read 01026 INTEGER, DIMENSION(:), INTENT(OUT) :: KYEAR ! year 01027 INTEGER, DIMENSION(:), INTENT(OUT) :: KMONTH ! month 01028 INTEGER, DIMENSION(:), INTENT(OUT) :: KDAY ! day 01029 REAL, DIMENSION(:), INTENT(OUT) :: PTIME ! year 01030 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 01031 CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment 01032 01033 !* 0.2 Declarations of local variables 01034 ! 01035 CHARACTER(LEN=18) :: YREC ! Name of the article to be read 01036 INTEGER :: ILUOUT 01037 INTEGER :: IGRID ! position of data on grid 01038 INTEGER :: ILENCH ! length of comment string 01039 INTEGER, DIMENSION(3,SIZE(KYEAR)) :: ITDATE 01040 REAL(KIND=JPRB) :: ZHOOK_HANDLE 01041 ! 01042 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFT1_LFI',0,ZHOOK_HANDLE) 01043 ! 01044 KRESP=0 01045 ! 01046 YREC=TRIM(HREC)//'%TDATE' 01047 CALL FMREADN2(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(ITDATE),ITDATE,IGRID,ILENCH,HCOMMENT,KRESP) 01048 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 01049 ! 01050 YREC=TRIM(HREC)//'%TIME' 01051 CALL FMREADX1(CFILE_LFI,YREC,CLUOUT_LFI,SIZE(PTIME),PTIME,IGRID,ILENCH,HCOMMENT,KRESP) 01052 CALL ERROR_READ_SURF_LFI(HREC,KRESP) 01053 ! 01054 KYEAR (:) = ITDATE(1,:) 01055 KMONTH(:) = ITDATE(2,:) 01056 KDAY (:) = ITDATE(3,:) 01057 ! 01058 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_LFI:READ_SURFT1_LFI',1,ZHOOK_HANDLE) 01059 ! 01060 END SUBROUTINE READ_SURFT1_LFI 01061 ! 01062 END MODULE MODE_READ_SURF_LFI
1.8.0
