SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/mode_read_surf

Go to the documentation of this file.
00001 MODULE MODE_READ_SURF_FA
00002 !!
00003 !!    PURPOSE
00004 !!    -------
00005 !
00006 !       The purpose of READ_SURF_FA 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_FA
00036         MODULE PROCEDURE READ_SURFX0_FA
00037         MODULE PROCEDURE READ_SURFN0_FA
00038         MODULE PROCEDURE READ_SURFL0_FA
00039         MODULE PROCEDURE READ_SURFC0_FA
00040 END INTERFACE
00041 INTERFACE READ_SURFN_FA
00042         MODULE PROCEDURE READ_SURFX1_FA
00043         MODULE PROCEDURE READ_SURFN1_FA
00044         MODULE PROCEDURE READ_SURFL1_FA
00045         MODULE PROCEDURE READ_SURFX2_FA
00046 END INTERFACE
00047 INTERFACE READ_SURFT_FA
00048         MODULE PROCEDURE READ_SURFT0_FA
00049         MODULE PROCEDURE READ_SURFT2_FA
00050 END INTERFACE
00051 !
00052 CONTAINS
00053 !
00054 !     #############################################################
00055       SUBROUTINE READ_SURFX0_FA(HREC,PFIELD,KRESP,HCOMMENT)
00056 !     #############################################################
00057 !
00058 !!****  *READX0* - routine to read a real scalar
00059 !
00060 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, CMASK
00061 !
00062 USE MODE_FASURFEX
00063 !
00064 USE MODI_IO_BUFF_n
00065 USE MODI_ERROR_READ_SURF_FA
00066 !
00067 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00068 USE PARKIND1  ,ONLY : JPRB
00069 !
00070 IMPLICIT NONE
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  CHARACTER(LEN=50) :: YCOMMENT
00082  CHARACTER(LEN=6)  :: YMASK
00083 LOGICAL           :: GFOUND
00084 LOGICAL           :: GKNOWN
00085  CHARACTER(LEN=18) :: YNAME ! Field Name
00086 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00087 !
00088 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX0_FA',0,ZHOOK_HANDLE)
00089 !
00090 KRESP=0
00091 !
00092 YMASK=CMASK
00093  CALL IO_BUFF_n(HREC,'R',GKNOWN)
00094 IF (GKNOWN) YMASK='FULL  '
00095 !
00096 YNAME=TRIM(YMASK)//TRIM(HREC)
00097  CALL FALIT_R(KRESP,NUNIT_FA,YNAME,PFIELD)
00098 IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00099 !
00100 YCOMMENT = TRIM(YNAME)
00101 HCOMMENT = YCOMMENT
00102 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX0_FA',1,ZHOOK_HANDLE)
00103 !
00104 END SUBROUTINE READ_SURFX0_FA
00105 !
00106 !     #############################################################
00107       SUBROUTINE READ_SURFX1_FA(HREC,KL,PFIELD,KRESP,HCOMMENT,HDIR)
00108 !     #############################################################
00109 !
00110 !!****  *READX1* - routine to fill a real 1D array for the externalised surface 
00111 !
00112 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, &
00113                             WLOG_MPI
00114 !
00115 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, NMASK, NFULL, NFULL_EXT, &
00116                                    NDGL, NDLON, NDGUX, NDLUX  
00117 !
00118 USE MODE_FASURFEX
00119 !
00120 USE MODI_IO_BUFF_n
00121 USE MODI_ERROR_READ_SURF_FA
00122 USE MODI_READ_AND_SEND_MPI
00123 !
00124 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00125 USE PARKIND1  ,ONLY : JPRB
00126 !
00127 IMPLICIT NONE
00128 !
00129 #ifndef NOMPI
00130 INCLUDE "mpif.h"
00131 #endif
00132 !
00133 !*      0.1   Declarations of arguments
00134 !
00135  CHARACTER(LEN=*),   INTENT(IN)  :: HREC     ! name of the article to be read
00136 INTEGER,             INTENT(IN)  :: KL       ! number of points
00137 REAL, DIMENSION(KL), INTENT(OUT) :: PFIELD   ! array containing the data field
00138 INTEGER,             INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
00139  CHARACTER(LEN=100),  INTENT(OUT) :: HCOMMENT ! comment
00140  CHARACTER(LEN=1),    INTENT(IN)  :: HDIR     ! type of field :
00141                                              ! 'H' : field with
00142                                              !       horizontal spatial dim.
00143                                              ! '-' : no horizontal dim.
00144 !*      0.2   Declarations of local variables
00145 !
00146  CHARACTER(LEN=50)          :: YCOMMENT
00147  CHARACTER(LEN=3)           :: YPREF
00148  CHARACTER(LEN=13)          :: YSUFF
00149 LOGICAL                    :: GFOUND
00150 !
00151 INTEGER ::  I, J, INFOMPI
00152 #ifndef NOMPI
00153 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00154 #endif
00155 !
00156 REAL, DIMENSION(NFULL)     :: ZWORK   ! work array read in the file
00157 REAL, DIMENSION(NFULL_EXT) :: ZWORK2
00158 DOUBLE PRECISION   :: XTIME0
00159 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00160 !
00161 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX1_FA',0,ZHOOK_HANDLE)
00162 !
00163 KRESP=0
00164 !
00165 #ifndef NOMPI
00166 XTIME0 = MPI_WTIME()
00167 #endif
00168 !
00169 IF (NRANK==NPIO) THEN
00170   !
00171 !$OMP SINGLE        
00172   !
00173   YPREF=HREC(1:3)
00174   YSUFF=HREC(4:16) 
00175   !
00176   IF (YPREF=='CLS' .OR. YPREF=='SUR' .OR. YPREF=='PRO' .OR. YPREF=='ATM') THEN
00177     CALL FACILE(KRESP,NUNIT_FA,HREC(1:4),0,HREC(5:16),ZWORK2,.FALSE.)
00178     IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00179     DO J=1,NDGUX
00180       DO I=1,NDLUX
00181         ZWORK((J-1)*NDLUX + I) = ZWORK2((J-1)*NDLON + I)
00182       ENDDO
00183     ENDDO
00184     YCOMMENT = TRIM(HREC)
00185   ELSE
00186     CALL FACILE(KRESP,NUNIT_FA,'S1D_',0,HREC,ZWORK,.FALSE.)
00187     IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)  
00188     YCOMMENT = 'S1D_'//TRIM(HREC)
00189   ENDIF
00190   !
00191   HCOMMENT = YCOMMENT
00192   !
00193 !$OMP END SINGLE COPYPRIVATE(ZWORK,HCOMMENT,KRESP)  
00194   !
00195 ENDIF
00196 !
00197 #ifndef NOMPI
00198 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
00199 #endif
00200 !
00201 IF (HDIR=='A') THEN  ! no distribution on other tasks
00202   IF ( NRANK==NPIO ) THEN
00203 #ifndef NOMPI          
00204     XTIME0 = MPI_WTIME()
00205 #endif    
00206     PFIELD(:) = ZWORK(1:KL)
00207 #ifndef NOMPI    
00208     XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00209 #endif    
00210   ENDIF
00211 ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks
00212 !$OMP SINGLE
00213     IF (NRANK==NPIO) PFIELD(:) = ZWORK(1:KL)
00214 #ifndef NOMPI          
00215     IF (NPROC>1) THEN
00216       XTIME0 = MPI_WTIME()
00217       CALL MPI_BCAST(PFIELD,SIZE(PFIELD)*KIND(PFIELD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
00218       XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00219     ENDIF
00220 #endif   
00221 !$OMP END SINGLE COPYPRIVATE(PFIELD)
00222 ELSE
00223   CALL READ_AND_SEND_MPI(ZWORK,PFIELD,NMASK)
00224 ENDIF
00225 ! 
00226 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX1_FA',1,ZHOOK_HANDLE)
00227 ! 
00228 END SUBROUTINE READ_SURFX1_FA
00229 !
00230 !     #############################################################
00231       SUBROUTINE READ_SURFX2_FA(HREC,KL1,KL2,PFIELD,KRESP,HCOMMENT,HDIR)
00232 !     #############################################################
00233 !
00234 !!****  *READX2* - routine to fill a real 2D array for the externalised surface 
00235 !
00236 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, &
00237                             WLOG_MPI
00238 !
00239 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, NMASK, NFULL
00240 !
00241 USE MODE_FASURFEX
00242 !
00243 USE MODI_IO_BUFF_n
00244 USE MODI_ERROR_READ_SURF_FA
00245 USE MODI_READ_AND_SEND_MPI
00246 !
00247 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00248 USE PARKIND1  ,ONLY : JPRB
00249 !
00250 IMPLICIT NONE
00251 !
00252 #ifndef NOMPI
00253 INCLUDE "mpif.h"
00254 #endif
00255 !
00256 !*      0.1   Declarations of arguments
00257 !
00258  CHARACTER(LEN=*),        INTENT(IN)  :: HREC     ! name of the article to be read
00259 INTEGER,                  INTENT(IN)  :: KL1      ! number of points
00260 INTEGER,                  INTENT(IN)  :: KL2      ! 2nd dimension
00261 REAL, DIMENSION(KL1,KL2), INTENT(OUT) :: PFIELD   ! array containing the data field
00262 INTEGER,                  INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
00263  CHARACTER(LEN=100),       INTENT(OUT) :: HCOMMENT ! comment
00264  CHARACTER(LEN=1),         INTENT(IN)  :: HDIR     ! type of field :
00265                                                   ! 'H' : field with
00266                                                   !       horizontal spatial dim.
00267                                                   ! '-' : no horizontal dim.
00268 !*      0.2   Declarations of local variables
00269 ! 
00270  CHARACTER(LEN=50)                     :: YCOMMENT
00271  CHARACTER(LEN=4)                      :: YSUFFIX
00272  CHARACTER(LEN=2)                      :: YPATCH
00273 LOGICAL                               :: GFOUND
00274 !
00275 INTEGER :: JL, I, INFOMPI ! loop counter
00276 #ifndef NOMPI
00277 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00278 #endif
00279 REAL, DIMENSION(NFULL,KL2) :: ZWORK   ! work array read in the file
00280 DOUBLE PRECISION   :: XTIME0
00281 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00282 !
00283 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX2_FA',0,ZHOOK_HANDLE)
00284 !
00285 KRESP=0
00286 !
00287 #ifndef NOMPI
00288 XTIME0 = MPI_WTIME()
00289 #endif
00290 !
00291 IF (NRANK==NPIO) THEN
00292   !
00293 !$OMP SINGLE
00294   !  
00295   DO JL=1,KL2
00296     WRITE(YPATCH,'(I2.2)')JL
00297     YSUFFIX='S'//YPATCH//'_'
00298     CALL FACILE(KRESP,NUNIT_FA,YSUFFIX,JL,HREC,ZWORK(:,JL),.FALSE.)
00299      IF (KRESP/=0) THEN
00300        YCOMMENT = YSUFFIX//TRIM(HREC)
00301        CALL ERROR_READ_SURF_FA(YCOMMENT,KRESP)
00302      ENDIF  
00303   END DO
00304   !
00305   YCOMMENT = 'PATCH_'//TRIM(HREC)
00306   HCOMMENT = YCOMMENT  
00307   !
00308 !$OMP END SINGLE COPYPRIVATE(ZWORK,HCOMMENT,KRESP)
00309   !
00310 ENDIF
00311 !
00312 #ifndef NOMPI
00313 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
00314 #endif
00315 !
00316 IF (HDIR=='A') THEN  ! no distribution on other tasks
00317   IF ( NRANK==NPIO ) THEN
00318 #ifndef NOMPI          
00319     XTIME0 = MPI_WTIME()
00320 #endif    
00321     PFIELD(:,:) = ZWORK(1:KL1,1:KL2)
00322 #ifndef NOMPI    
00323     XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00324 #endif    
00325   ENDIF
00326 ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks
00327 !$OMP SINGLE
00328   IF (NRANK==NPIO) PFIELD(:,:) = ZWORK(1:KL1,1:KL2)
00329 #ifndef NOMPI
00330   IF (NPROC>1) THEN
00331     XTIME0 = MPI_WTIME()
00332     CALL MPI_BCAST(PFIELD(:,:),SIZE(PFIELD)*KIND(PFIELD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
00333     XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00334   ENDIF
00335 #endif    
00336 !$OMP END SINGLE COPYPRIVATE(PFIELD)
00337 ELSE
00338   CALL READ_AND_SEND_MPI(ZWORK,PFIELD,NMASK)
00339 ENDIF
00340 !  
00341 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX2_FA',1,ZHOOK_HANDLE)
00342 !
00343 END SUBROUTINE READ_SURFX2_FA
00344 !
00345 !     #############################################################
00346       SUBROUTINE READ_SURFN0_FA(HREC,KFIELD,KRESP,HCOMMENT)
00347 !     #############################################################
00348 !
00349 !!****  *READN0* - routine to read an integer
00350 !
00351 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, NMASK, CMASK
00352 !
00353 USE MODE_FASURFEX
00354 !
00355 USE MODI_IO_BUFF_n
00356 USE MODI_ERROR_READ_SURF_FA
00357 !
00358 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00359 USE PARKIND1  ,ONLY : JPRB
00360 !
00361 IMPLICIT NONE
00362 !
00363 !*      0.1   Declarations of arguments
00364 !
00365  CHARACTER(LEN=*),  INTENT(IN)  :: HREC     ! name of the article to be read
00366 INTEGER,            INTENT(OUT) :: KFIELD   ! the integer to be read
00367 INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
00368  CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
00369 !
00370 !*      0.2   Declarations of local variables
00371 !
00372  CHARACTER(LEN=50) :: YCOMMENT
00373  CHARACTER(LEN=6)  :: YMASK
00374 LOGICAL           :: GFOUND
00375 LOGICAL           :: GKNOWN
00376  CHARACTER(LEN=18) :: YNAME ! Field Name
00377 REAL(KIND=JPRB)  :: ZHOOK_HANDLE
00378 !
00379 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFN0_FA',0,ZHOOK_HANDLE)
00380 !
00381 KRESP=0
00382 !
00383 YMASK=CMASK
00384  CALL IO_BUFF_n(HREC,'R',GKNOWN)
00385 IF (GKNOWN) YMASK='FULL  '
00386 !
00387 YNAME=TRIM(YMASK)//TRIM(HREC)
00388  CALL FALIT_I(KRESP,NUNIT_FA,YNAME,KFIELD)
00389 IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00390 !
00391 YCOMMENT = YNAME
00392 HCOMMENT = YCOMMENT
00393 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFN0_FA',1,ZHOOK_HANDLE)
00394 !
00395 END SUBROUTINE READ_SURFN0_FA
00396 !
00397 !     #############################################################
00398       SUBROUTINE READ_SURFN1_FA(HREC,KL,KFIELD,KRESP,HCOMMENT,HDIR)
00399 !     #############################################################
00400 !
00401 !!****  *READN0* - routine to read an integer
00402 !
00403 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, & 
00404                             WLOG_MPI
00405 !
00406 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, NMASK, NFULL, CMASK
00407 !
00408 USE MODE_FASURFEX
00409 !
00410 USE MODI_IO_BUFF_n
00411 USE MODI_ERROR_READ_SURF_FA
00412 USE MODI_READ_AND_SEND_MPI
00413 !
00414 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00415 USE PARKIND1  ,ONLY : JPRB
00416 !
00417 IMPLICIT NONE
00418 !
00419 #ifndef NOMPI
00420 INCLUDE "mpif.h"
00421 #endif
00422 !
00423 !*      0.1   Declarations of arguments
00424 !
00425  CHARACTER(LEN=*),      INTENT(IN)  :: HREC     ! name of the article to be read
00426 INTEGER,                INTENT(IN)  :: KL       ! number of points
00427 INTEGER, DIMENSION(KL), INTENT(OUT) :: KFIELD   ! the integer to be read
00428 INTEGER,                INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
00429  CHARACTER(LEN=100),     INTENT(OUT) :: HCOMMENT ! comment
00430  CHARACTER(LEN=1),       INTENT(IN)  :: HDIR     ! type of field :
00431                                                 ! 'H' : field with
00432                                                 !       horizontal spatial dim.
00433                                                 ! '-' : no horizontal dim.
00434 !*      0.2   Declarations of local variables
00435 !
00436  CHARACTER(LEN=50) :: YCOMMENT
00437  CHARACTER(LEN=6)  :: YMASK
00438  CHARACTER(LEN=18) :: YNAME ! Field Name
00439 LOGICAL           :: GFOUND
00440 LOGICAL           :: GKNOWN
00441 !
00442 INTEGER ::  I, INFOMPI
00443 #ifndef NOMPI
00444 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00445 #endif
00446 !
00447 INTEGER, DIMENSION(NFULL) :: IWORK  ! work array read in the file
00448 DOUBLE PRECISION   :: XTIME0
00449 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00450 !
00451 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFN1_FA',0,ZHOOK_HANDLE)
00452 !
00453 KRESP = 0
00454 !
00455 #ifndef NOMPI
00456 XTIME0 = MPI_WTIME()
00457 #endif
00458 !
00459 IF (NRANK==NPIO) THEN
00460   !
00461 !$OMP SINGLE        
00462   !
00463   YMASK = CMASK
00464   CALL IO_BUFF_n(HREC,'R',GKNOWN)
00465   IF (GKNOWN) YMASK = 'FULL  '
00466   !
00467   YNAME = TRIM(YMASK)//TRIM(HREC)
00468   IF (HDIR=="-") THEN
00469     CALL FALIT_I_D(KRESP,NUNIT_FA,YNAME,KL,IWORK(1:KL))
00470     IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00471   ELSE
00472     CALL FALIT_I_D(KRESP,NUNIT_FA,YNAME,NFULL,IWORK)
00473     IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00474   ENDIF
00475   !
00476   YCOMMENT = YNAME
00477   HCOMMENT = YCOMMENT
00478   !
00479 !$OMP END SINGLE COPYPRIVATE(IWORK,HCOMMENT,KRESP)  
00480   !
00481 ENDIF
00482 !
00483 #ifndef NOMPI
00484 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
00485 #endif
00486 !
00487 IF (HDIR=='A') THEN  ! no distribution on other tasks
00488   IF ( NRANK==NPIO ) THEN
00489 #ifndef NOMPI          
00490     XTIME0 = MPI_WTIME()
00491 #endif    
00492     KFIELD(:) = IWORK(1:KL)
00493 #ifndef NOMPI    
00494     XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00495 #endif    
00496   ENDIF
00497 ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks
00498 !$OMP SINGLE     
00499   IF (NRANK==NPIO) KFIELD(:) = IWORK(1:KL)
00500 #ifndef NOMPI
00501   IF (NPROC>1) THEN
00502     XTIME0 = MPI_WTIME()
00503     CALL MPI_BCAST(KFIELD,SIZE(KFIELD)*KIND(KFIELD)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
00504     XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00505   ENDIF
00506 #endif    
00507 !$OMP END SINGLE COPYPRIVATE(KFIELD)
00508 ELSE
00509   CALL READ_AND_SEND_MPI(IWORK,KFIELD,NMASK)
00510 ENDIF
00511 !
00512 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFN1_FA',1,ZHOOK_HANDLE)
00513 !
00514 END SUBROUTINE READ_SURFN1_FA
00515 !
00516 !     #############################################################
00517       SUBROUTINE READ_SURFC0_FA(HREC,HFIELD,KRESP,HCOMMENT)
00518 !     #############################################################
00519 !
00520 !!****  *READC0* - routine to read a character
00521 !
00522 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, CMASK
00523 !
00524 USE MODE_FASURFEX
00525 !
00526 USE MODI_IO_BUFF_n
00527 USE MODI_ERROR_READ_SURF_FA
00528 !
00529 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00530 USE PARKIND1  ,ONLY : JPRB
00531 !
00532 IMPLICIT NONE
00533 !
00534 !*      0.1   Declarations of arguments
00535 !
00536  CHARACTER(LEN=*),  INTENT(IN)  :: HREC      ! name of the article to be read
00537  CHARACTER(LEN=40),  INTENT(OUT) :: HFIELD    ! the integer to be read
00538 INTEGER,            INTENT(OUT) :: KRESP     ! KRESP  : return-code if a problem appears
00539  CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT  ! comment
00540 !
00541 !*      0.2   Declarations of local variables
00542 !
00543  CHARACTER(LEN=50) :: YCOMMENT
00544  CHARACTER(LEN=6)  :: YMASK
00545  CHARACTER(LEN=18) :: YNAME ! Field Name
00546  CHARACTER,DIMENSION(40) :: YFIELD
00547 LOGICAL           :: GFOUND
00548 LOGICAL           :: GKNOWN
00549 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00550 !----------------------------------------------------------------------------
00551 !
00552 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFC0_FA',0,ZHOOK_HANDLE)
00553 !
00554 KRESP=0
00555 !
00556 YMASK=CMASK
00557  CALL IO_BUFF_n(HREC,'R',GKNOWN)
00558 IF (GKNOWN) YMASK='FULL  '
00559 !
00560 YNAME=TRIM(YMASK)//TRIM(HREC)
00561  CALL FALIT_C(KRESP,NUNIT_FA,YNAME,40,YFIELD)
00562 IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00563 WRITE(HFIELD,'(40A1)') YFIELD(:)
00564 !
00565 YCOMMENT = YNAME
00566 HCOMMENT = YCOMMENT
00567 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFC0_FA',1,ZHOOK_HANDLE)
00568 !
00569 END SUBROUTINE READ_SURFC0_FA
00570 !
00571 !     #############################################################
00572       SUBROUTINE READ_SURFL0_FA(HREC,OFIELD,KRESP,HCOMMENT)
00573 !     #############################################################
00574 !
00575 !!****  *READL0* - routine to read a logical
00576 !
00577 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, CMASK
00578 !
00579 USE MODE_FASURFEX
00580 !
00581 USE MODI_IO_BUFF_n
00582 USE MODI_ERROR_READ_SURF_FA
00583 !
00584 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00585 USE PARKIND1  ,ONLY : JPRB
00586 !
00587 IMPLICIT NONE
00588 !
00589 !*      0.1   Declarations of arguments
00590 !
00591  CHARACTER(LEN=*),  INTENT(IN)  :: HREC     ! name of the article to be read
00592 LOGICAL,            INTENT(OUT) :: OFIELD   ! array containing the data field
00593 INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
00594  CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
00595 !
00596 !*      0.2   Declarations of local variables
00597 !
00598  CHARACTER(LEN=50) :: YCOMMENT
00599  CHARACTER(LEN=6)  :: YMASK
00600  CHARACTER(LEN=18) :: YNAME ! Field Name
00601 LOGICAL           :: GFOUND
00602 LOGICAL           :: GKNOWN
00603 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00604 !
00605 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFL0_FA',0,ZHOOK_HANDLE)
00606 !
00607 KRESP=0
00608 !
00609 YMASK=CMASK
00610  CALL IO_BUFF_n(HREC,'R',GKNOWN)
00611 IF (GKNOWN) YMASK='FULL  '
00612 !
00613 YNAME=TRIM(YMASK)//TRIM(HREC)
00614  CALL FALIT_L(KRESP,NUNIT_FA,YNAME,OFIELD)
00615 IF (KRESP/=0)CALL ERROR_READ_SURF_FA(HREC,KRESP)
00616 !
00617 YCOMMENT = YNAME
00618 HCOMMENT = YCOMMENT
00619 !
00620 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFL0_FA',1,ZHOOK_HANDLE)
00621 !
00622 END SUBROUTINE READ_SURFL0_FA
00623 !
00624 !     #############################################################
00625       SUBROUTINE READ_SURFL1_FA(HREC,KL,OFIELD,KRESP,HCOMMENT,HDIR)
00626 !     #############################################################
00627 !
00628 !!****  *READL1* - routine to read a logical array
00629 !
00630 USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, &
00631                             WLOG_MPI
00632 !
00633 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, CMASK
00634 !
00635 USE MODE_FASURFEX
00636 !
00637 USE MODI_IO_BUFF_n
00638 USE MODI_ERROR_READ_SURF_FA
00639 !
00640 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00641 USE PARKIND1  ,ONLY : JPRB
00642 !
00643 IMPLICIT NONE
00644 !
00645 #ifndef NOMPI
00646 INCLUDE "mpif.h"
00647 #endif
00648 !
00649 !*      0.1   Declarations of arguments
00650 !
00651  CHARACTER(LEN=*),      INTENT(IN)  :: HREC     ! name of the article to be read
00652 INTEGER,                INTENT(IN)  :: KL       ! number of points
00653 LOGICAL, DIMENSION(KL), INTENT(OUT) :: OFIELD   ! array containing the data field
00654 INTEGER,                INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
00655  CHARACTER(LEN=100),     INTENT(OUT) :: HCOMMENT ! comment
00656  CHARACTER(LEN=1),       INTENT(IN)  :: HDIR     ! type of field :
00657                                                 ! 'H' : field with
00658                                                 !       horizontal spatial dim.
00659                                                 ! '-' : no horizontal dim.
00660 !*      0.2   Declarations of local variables
00661 !
00662  CHARACTER(LEN=50) :: YCOMMENT
00663  CHARACTER(LEN=6)  :: YMASK
00664  CHARACTER(LEN=18) :: YNAME ! Field Name
00665 LOGICAL           :: GFOUND
00666 LOGICAL           :: GKNOWN
00667 INTEGER           :: INFOMPI
00668 DOUBLE PRECISION  :: XTIME0
00669 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00670 !
00671 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFL1_FA',0,ZHOOK_HANDLE)
00672 !
00673 #ifndef NOMPI
00674 XTIME0 = MPI_WTIME()
00675 #endif
00676 !
00677 IF (NRANK==NPIO) THEN
00678   !
00679 !$OMP SINGLE
00680   !   
00681   KRESP=0
00682   !
00683   YMASK=CMASK
00684   CALL IO_BUFF_n(HREC,'R',GKNOWN)
00685   IF (GKNOWN) YMASK='FULL  '
00686   !
00687   YNAME=TRIM(YMASK)//TRIM(HREC)
00688   CALL FALIT_L_D(KRESP,NUNIT_FA,YNAME,KL,OFIELD)
00689   IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00690   !
00691   YCOMMENT = YNAME
00692   HCOMMENT = YCOMMENT
00693   !
00694 !$OMP END SINGLE COPYPRIVATE(OFIELD,HCOMMENT,KRESP)  
00695   !
00696 ENDIF
00697 !
00698 #ifndef NOMPI
00699 XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
00700 #endif
00701 !
00702 #ifndef NOMPI
00703 IF (NPROC>1 .AND. HDIR/='A') THEN
00704 !$OMP SINGLE         
00705   XTIME0 = MPI_WTIME()
00706   CALL MPI_BCAST(OFIELD,SIZE(OFIELD),MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
00707   XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00708 !$OMP END SINGLE COPYPRIVATE(OFIELD)  
00709 ENDIF
00710 #endif
00711 !
00712 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFL1_FA',1,ZHOOK_HANDLE)
00713 !
00714 END SUBROUTINE READ_SURFL1_FA
00715 !
00716 !     #############################################################
00717       SUBROUTINE READ_SURFT0_FA(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
00718 !     #############################################################
00719 !
00720 !!****  *READT0* - routine to read a date
00721 !
00722 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, CMASK
00723 !
00724 USE MODE_FASURFEX
00725 !
00726 USE MODI_IO_BUFF_n
00727 USE MODI_ERROR_READ_SURF_FA
00728 !
00729 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00730 USE PARKIND1  ,ONLY : JPRB
00731 !
00732 IMPLICIT NONE
00733 !
00734 !*      0.1   Declarations of arguments
00735 !
00736  CHARACTER(LEN=*),  INTENT(IN)  :: HREC     ! name of the article to be read
00737 INTEGER,            INTENT(OUT) :: KYEAR    ! year
00738 INTEGER,            INTENT(OUT) :: KMONTH   ! month
00739 INTEGER,            INTENT(OUT) :: KDAY     ! day
00740 REAL,               INTENT(OUT) :: PTIME    ! year
00741 INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
00742  CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
00743 
00744 !*      0.2   Declarations of local variables
00745 !
00746  CHARACTER(LEN=50) :: YCOMMENT
00747  CHARACTER(LEN=6)  :: YMASK
00748  CHARACTER(LEN=18) :: YNAME ! Field Name
00749 LOGICAL           :: GFOUND
00750 LOGICAL          :: GKNOWN
00751 INTEGER, DIMENSION(3) :: ITDATE
00752 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00753 !
00754 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFT0_FA',0,ZHOOK_HANDLE)
00755 !
00756 KRESP=0
00757 !
00758 YMASK=CMASK
00759  CALL IO_BUFF_n(HREC,'R',GKNOWN)
00760 IF (GKNOWN) YMASK='FULL  '
00761 !
00762 YNAME=TRIM(YMASK)//TRIM(HREC)//'%TDATE'
00763  CALL FALIT_I_D(KRESP,NUNIT_FA,YNAME,3,ITDATE)
00764 IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00765 !
00766 KYEAR  = ITDATE(1)
00767 KMONTH = ITDATE(2)
00768 KDAY   = ITDATE(3)
00769 !
00770 YNAME=TRIM(YMASK)//TRIM(HREC)//'%TIME'
00771  CALL FALIT_R(KRESP,NUNIT_FA,YNAME,PTIME)
00772 IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
00773 !
00774 YCOMMENT = TRIM(HREC)
00775 HCOMMENT = YCOMMENT
00776 !
00777 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFT0_FA',1,ZHOOK_HANDLE)
00778 !
00779 END SUBROUTINE READ_SURFT0_FA
00780 !
00781 !     #############################################################
00782       SUBROUTINE READ_SURFT2_FA(HREC,KL1,KL2,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
00783 !     #############################################################
00784 !
00785 !!****  *READT2* - routine to read a date
00786 !
00787 USE MODD_IO_SURF_FA,        ONLY : NUNIT_FA, NLUOUT, CMASK
00788 !
00789 USE MODE_FASURFEX
00790 !
00791 USE MODI_IO_BUFF_n
00792 USE MODI_ABOR1_SFX
00793 USE MODI_ERROR_READ_SURF_FA
00794 !
00795 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00796 USE PARKIND1  ,ONLY : JPRB
00797 !
00798 IMPLICIT NONE
00799 !
00800 !*      0.1   Declarations of arguments
00801 !
00802  CHARACTER(LEN=*),  INTENT(IN)  :: HREC     ! name of the article to be read
00803 INTEGER                                  :: KL1, KL2
00804 INTEGER, DIMENSION(KL1,KL2), INTENT(OUT) :: KYEAR    ! year
00805 INTEGER, DIMENSION(KL1,KL2), INTENT(OUT) :: KMONTH   ! month
00806 INTEGER, DIMENSION(KL1,KL2), INTENT(OUT) :: KDAY     ! day
00807 REAL,    DIMENSION(KL1,KL2), INTENT(OUT) :: PTIME    ! year
00808 INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
00809  CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
00810 
00811 !*      0.2   Declarations of local variables
00812 !
00813  CHARACTER(LEN=50) :: YCOMMENT
00814  CHARACTER(LEN=6)  :: YMASK
00815  CHARACTER(LEN=18) :: YNAME ! Field Name
00816 LOGICAL           :: GFOUND
00817 LOGICAL           :: GKNOWN
00818 INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE
00819 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00820 !
00821 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFT2_FA',0,ZHOOK_HANDLE)
00822 !
00823 KRESP=0
00824 !
00825 YMASK=CMASK
00826  CALL IO_BUFF_n(HREC,'R',GKNOWN)
00827 IF (GKNOWN) YMASK='FULL  '
00828 !
00829 YNAME=TRIM(CMASK)//TRIM(HREC)
00830 WRITE(NLUOUT,*) ' READ_SURFT2_FA : time in 2 dimensions not yet implemented : YNAME=',YNAME
00831  CALL ABOR1_SFX('MODE_READ_SURF_FA:READ_SURFT2_FA: time in 2 dimensions not yet implemented')
00832 !
00833 HCOMMENT = YCOMMENT
00834 !
00835 IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFT2_FA',1,ZHOOK_HANDLE)
00836 !
00837 END SUBROUTINE READ_SURFT2_FA
00838 !
00839 END MODULE MODE_READ_SURF_FA