|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######spl 00002 MODULE MODE_WRITE_SURF_LFI 00003 ! 00004 USE MODI_GET_LUOUT 00005 INTERFACE WRITE_SURF0_LFI 00006 MODULE PROCEDURE WRITE_SURFX0_LFI 00007 MODULE PROCEDURE WRITE_SURFN0_LFI 00008 MODULE PROCEDURE WRITE_SURFL0_LFI 00009 MODULE PROCEDURE WRITE_SURFC0_LFI 00010 END INTERFACE 00011 INTERFACE WRITE_SURFN_LFI 00012 MODULE PROCEDURE WRITE_SURFX1_LFI 00013 MODULE PROCEDURE WRITE_SURFN1_LFI 00014 MODULE PROCEDURE WRITE_SURFL1_LFI 00015 MODULE PROCEDURE WRITE_SURFX2_LFI 00016 END INTERFACE 00017 INTERFACE WRITE_SURFT_LFI 00018 MODULE PROCEDURE WRITE_SURFT0_LFI 00019 MODULE PROCEDURE WRITE_SURFT1_LFI 00020 END INTERFACE 00021 ! 00022 CONTAINS 00023 ! 00024 ! ############################################################# 00025 SUBROUTINE WRITE_SURFX0_LFI(HREC,PFIELD,KRESP,HCOMMENT) 00026 ! ############################################################# 00027 ! 00028 !!**** * - routine to write a real scalar 00029 ! 00030 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI 00031 ! 00032 USE MODI_IO_BUFF_n 00033 USE MODI_FMWRIT 00034 USE MODI_ERROR_WRITE_SURF_LFI 00035 ! 00036 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00037 USE PARKIND1 ,ONLY : JPRB 00038 ! 00039 IMPLICIT NONE 00040 ! 00041 !* 0.1 Declarations of arguments 00042 ! 00043 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00044 REAL, INTENT(IN) :: PFIELD ! the real scalar to be read 00045 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00046 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00047 ! 00048 !* 0.2 Declarations of local variables 00049 ! 00050 LOGICAL :: GKNOWN 00051 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00052 ! 00053 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX0_LFI',0,ZHOOK_HANDLE) 00054 ! 00055 KRESP=0 00056 ! 00057 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00058 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX0_LFI',1,ZHOOK_HANDLE) 00059 IF (GKNOWN) RETURN 00060 ! 00061 CALL FMWRITX0(CFILEOUT_LFI,HREC,CLUOUT_LFI,1,PFIELD,4,100,HCOMMENT,KRESP) 00062 ! 00063 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00064 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX0_LFI',1,ZHOOK_HANDLE) 00065 ! 00066 END SUBROUTINE WRITE_SURFX0_LFI 00067 ! 00068 ! ############################################################# 00069 SUBROUTINE WRITE_SURFN0_LFI(HREC,KFIELD,KRESP,HCOMMENT) 00070 ! ############################################################# 00071 ! 00072 !!**** * - routine to write an integer 00073 ! 00074 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI, & 00075 LMNH_COMPATIBLE, NIU, NIB, NIE, NJU, NJB, NJE 00076 ! 00077 USE MODI_IO_BUFF_n 00078 USE MODI_FMWRIT 00079 USE MODI_ERROR_WRITE_SURF_LFI 00080 ! 00081 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00082 USE PARKIND1 ,ONLY : JPRB 00083 ! 00084 IMPLICIT NONE 00085 ! 00086 !* 0.1 Declarations of arguments 00087 ! 00088 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00089 INTEGER, INTENT(IN) :: KFIELD ! the integer to be read 00090 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00091 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00092 ! 00093 !* 0.2 Declarations of local variables 00094 ! 00095 LOGICAL :: GKNOWN 00096 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00097 ! 00098 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFN0_LFI',0,ZHOOK_HANDLE) 00099 ! 00100 KRESP=0 00101 ! 00102 IF (LMNH_COMPATIBLE .AND. HREC=='IMAX') THEN 00103 NIU = KFIELD+2 00104 NIB = 2 00105 NIE = KFIELD+1 00106 END IF 00107 IF (LMNH_COMPATIBLE .AND. HREC=='JMAX') THEN 00108 NJU = KFIELD+2 00109 NJB = 2 00110 NJE = KFIELD+1 00111 END IF 00112 ! 00113 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00114 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFN0_LFI',1,ZHOOK_HANDLE) 00115 IF (GKNOWN) RETURN 00116 ! 00117 CALL FMWRITN0(CFILEOUT_LFI,HREC,CLUOUT_LFI,1,KFIELD,4,100,HCOMMENT,KRESP) 00118 ! 00119 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00120 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFN0_LFI',1,ZHOOK_HANDLE) 00121 ! 00122 END SUBROUTINE WRITE_SURFN0_LFI 00123 ! 00124 ! ############################################################# 00125 SUBROUTINE WRITE_SURFL0_LFI(HREC,OFIELD,KRESP,HCOMMENT) 00126 ! ############################################################# 00127 ! 00128 !!**** * - routine to write a logical 00129 ! 00130 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI 00131 ! 00132 USE MODI_IO_BUFF_n 00133 USE MODI_FMWRIT 00134 USE MODI_ERROR_WRITE_SURF_LFI 00135 ! 00136 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00137 USE PARKIND1 ,ONLY : JPRB 00138 ! 00139 IMPLICIT NONE 00140 ! 00141 !* 0.1 Declarations of arguments 00142 ! 00143 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00144 LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field 00145 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00146 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00147 ! 00148 !* 0.2 Declarations of local variables 00149 ! 00150 LOGICAL :: GKNOWN 00151 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00152 ! 00153 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFL0_LFI',0,ZHOOK_HANDLE) 00154 ! 00155 KRESP=0 00156 ! 00157 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00158 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFL0_LFI',1,ZHOOK_HANDLE) 00159 IF (GKNOWN) RETURN 00160 ! 00161 CALL FMWRITL0(CFILEOUT_LFI,HREC,CLUOUT_LFI,1,OFIELD,4,100,HCOMMENT,KRESP) 00162 ! 00163 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00164 ! 00165 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFL0_LFI',1,ZHOOK_HANDLE) 00166 ! 00167 END SUBROUTINE WRITE_SURFL0_LFI 00168 ! 00169 ! ############################################################# 00170 SUBROUTINE WRITE_SURFC0_LFI(HREC,HFIELD,KRESP,HCOMMENT) 00171 ! ############################################################# 00172 ! 00173 !!**** * - routine to write a character 00174 ! 00175 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI, LMNH_COMPATIBLE, LCARTESIAN 00176 ! 00177 USE MODI_IO_BUFF_n 00178 USE MODI_FMWRIT 00179 USE MODI_ERROR_WRITE_SURF_LFI 00180 ! 00181 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00182 USE PARKIND1 ,ONLY : JPRB 00183 ! 00184 IMPLICIT NONE 00185 ! 00186 !* 0.1 Declarations of arguments 00187 ! 00188 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00189 CHARACTER(LEN=40), INTENT(IN) :: HFIELD ! the integer to be read 00190 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00191 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00192 ! 00193 !* 0.2 Declarations of local variables 00194 ! 00195 LOGICAL :: GKNOWN 00196 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00197 ! 00198 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFC0_LFI',0,ZHOOK_HANDLE) 00199 ! 00200 KRESP=0 00201 ! 00202 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00203 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFC0_LFI',1,ZHOOK_HANDLE) 00204 IF (GKNOWN) RETURN 00205 ! 00206 CALL FMWRITC0(CFILEOUT_LFI,HREC,CLUOUT_LFI,1,HFIELD,4,100,HCOMMENT,KRESP) 00207 ! 00208 IF (HREC=="GRID_TYPE") LMNH_COMPATIBLE = (HFIELD=="CARTESIAN " .OR. HFIELD=="CONF PROJ ") 00209 IF (HREC=="GRID_TYPE" .AND. LMNH_COMPATIBLE) LCARTESIAN=(HFIELD=="CARTESIAN ") 00210 ! 00211 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00212 ! 00213 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFC0_LFI',1,ZHOOK_HANDLE) 00214 ! 00215 END SUBROUTINE WRITE_SURFC0_LFI 00216 ! 00217 ! ############################################################# 00218 SUBROUTINE WRITE_SURFX1_LFI(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00219 ! ############################################################# 00220 ! 00221 !!**** * - routine to fill a write 1D array for the externalised surface 00222 ! 00223 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00224 ! 00225 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI, NMASK, NFULL, & 00226 LMNH_COMPATIBLE, NIU, NIB, NIE, NJU, NJB, NJE 00227 ! 00228 USE MODI_IO_BUFF_n 00229 USE MODI_FMWRIT 00230 USE MODI_ERROR_WRITE_SURF_LFI 00231 USE MODI_GATHER_AND_WRITE_MPI 00232 USE MODI_GET_SURF_UNDEF 00233 ! 00234 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00235 USE PARKIND1 ,ONLY : JPRB 00236 ! 00237 IMPLICIT NONE 00238 ! 00239 #ifndef NOMPI 00240 INCLUDE "mpif.h" 00241 #endif 00242 ! 00243 !* 0.1 Declarations of arguments 00244 ! 00245 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00246 REAL, DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field 00247 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00248 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00249 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00250 ! 'H' : field with 00251 ! horizontal spatial dim. 00252 ! '-' : no horizontal dim. 00253 !* 0.2 Declarations of local variables 00254 ! 00255 CHARACTER(LEN=20) :: YREC 00256 LOGICAL :: GKNOWN 00257 INTEGER :: JI, JJ 00258 DOUBLE PRECISION :: XTIME0 00259 REAL :: ZUNDEF ! default value 00260 REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD))) :: ZWORK ! work array read in the file 00261 REAL, DIMENSION(NIU,NJU) :: ZWORK2D ! work array read in a MNH file 00262 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00263 ! 00264 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI',0,ZHOOK_HANDLE) 00265 ! 00266 KRESP=0 00267 ! 00268 !$OMP SINGLE 00269 ! 00270 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00271 ! 00272 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00273 ! 00274 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI',1,ZHOOK_HANDLE) 00275 IF (GKNOWN) RETURN 00276 ! 00277 IF (HDIR=='H') CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK) 00278 ! 00279 IF (NRANK==NPIO) THEN 00280 ! 00281 #ifndef NOMPI 00282 XTIME0 = MPI_WTIME() 00283 #endif 00284 ! 00285 !$OMP SINGLE 00286 ! 00287 IF (HDIR=='H') THEN 00288 ! 00289 CALL GET_SURF_UNDEF(ZUNDEF) 00290 ! 00291 IF (.NOT. LMNH_COMPATIBLE) THEN 00292 CALL FMWRITX1(CFILEOUT_LFI,HREC,CLUOUT_LFI,NFULL,ZWORK,4,100,HCOMMENT,KRESP) 00293 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00294 ELSE 00295 ! 00296 ZWORK2D(:,:) = ZUNDEF 00297 DO JJ=1,NJE-NJB+1 00298 DO JI=1,NIE-NIB+1 00299 ZWORK2D(NIB+JI-1,NJB+JJ-1) = ZWORK(JI+(NIE-NIB+1)*(JJ-1)) 00300 END DO 00301 END DO 00302 ! 00303 IF (HREC=='DX ' .OR. HREC=='XX ') THEN 00304 YREC = 'XHAT' 00305 CALL WRITE_IN_LFI_X1_FOR_MNH(HREC,YREC,ZWORK2D(NIB:NIE,NJB),KRESP,HCOMMENT,NIU,NIB,NIE) 00306 ELSEIF (HREC=='DY ' .OR. HREC=='YY ') THEN 00307 YREC = 'YHAT' 00308 CALL WRITE_IN_LFI_X1_FOR_MNH(HREC,YREC,ZWORK2D(NIB,NJB:NJE),KRESP,HCOMMENT,NJU,NJB,NJE) 00309 ELSEIF (NJB==NJE) THEN 00310 YREC = HREC 00311 CALL WRITE_IN_LFI_X1_FOR_MNH(HREC,YREC,ZWORK2D(:,NJB),KRESP,HCOMMENT,NIU,NIB,NIE) 00312 ELSEIF (NIB==NIE) THEN 00313 YREC = HREC 00314 CALL WRITE_IN_LFI_X1_FOR_MNH(HREC,YREC,ZWORK2D(NIB,:),KRESP,HCOMMENT,NJU,NJB,NJE) 00315 ELSE 00316 CALL FMWRITX2(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(ZWORK2D),ZWORK2D,4,100,HCOMMENT,KRESP) 00317 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00318 ENDIF 00319 ! 00320 END IF 00321 ! 00322 ELSE 00323 CALL FMWRITX1(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(PFIELD),PFIELD,4,100,HCOMMENT,KRESP) 00324 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00325 END IF 00326 ! 00327 !$OMP END SINGLE COPYPRIVATE(KRESP) 00328 ! 00329 #ifndef NOMPI 00330 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00331 #endif 00332 ! 00333 ENDIF 00334 ! 00335 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI',1,ZHOOK_HANDLE) 00336 ! 00337 CONTAINS 00338 ! 00339 ! ############################################################# 00340 SUBROUTINE WRITE_IN_LFI_X1_FOR_MNH(HREC,HREC2,PFIELD,KRESP,HCOMMENT,KU,KB,KE) 00341 ! ############################################################# 00342 ! 00343 !!**** * - routine to fill a write 2D array for the externalised surface 00344 ! 00345 IMPLICIT NONE 00346 ! 00347 !* 0.1 Declarations of arguments 00348 ! 00349 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00350 CHARACTER(LEN=20), INTENT(IN) :: HREC2 ! name of the article to be read 00351 REAL, DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field 00352 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00353 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00354 INTEGER, INTENT(IN) :: KU 00355 INTEGER, INTENT(IN) :: KB 00356 INTEGER, INTENT(IN) :: KE 00357 ! 00358 !* 0.2 Declarations of local variables 00359 ! 00360 REAL, DIMENSION(KU) :: ZWORK ! 1D work array read in the file 00361 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00362 ! 00363 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI:WRITE_IN_LFI_X1_FOR_MNH',0,ZHOOK_HANDLE) 00364 ! 00365 ZWORK(:) = 0. 00366 ! 00367 SELECT CASE(HREC) 00368 ! 00369 CASE('DX ','DY ') 00370 IF (KB/=KE) THEN 00371 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI:WRITE_IN_LFI_X1_FOR_MNH',1,ZHOOK_HANDLE) 00372 RETURN 00373 ENDIF 00374 ZWORK(1) = - PFIELD(1)*0.5 ! 1D case 00375 ZWORK(2) = PFIELD(1)*0.5 00376 ZWORK(3) = PFIELD(1)*1.5 00377 ! 00378 CASE('XX ','YY ') 00379 IF (KB==KE) THEN 00380 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI:WRITE_IN_LFI_X1_FOR_MNH',1,ZHOOK_HANDLE) 00381 RETURN 00382 ENDIF 00383 ZWORK(KB+1:KE) = 0.5 * PFIELD(1:KE-2) + 0.5 * PFIELD(2:KE-1) 00384 ZWORK(KB) = 1.5 * PFIELD(1) - 0.5 * PFIELD(2) 00385 ZWORK(KB-1) = 2. * ZWORK(KB) - ZWORK(KB+1) 00386 ZWORK(KE+1) = 2. * ZWORK(KE) - ZWORK(KE-1) 00387 CASE DEFAULT 00388 ZWORK(:) = PFIELD(:) 00389 ! 00390 END SELECT 00391 ! 00392 CALL FMWRITX1(CFILEOUT_LFI,HREC2,CLUOUT_LFI,KU,ZWORK,4,100,HCOMMENT,KRESP) 00393 CALL ERROR_WRITE_SURF_LFI(HREC2,KRESP) 00394 ! 00395 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI:WRITE_IN_LFI_X1_FOR_MNH',1,ZHOOK_HANDLE) 00396 END SUBROUTINE WRITE_IN_LFI_X1_FOR_MNH 00397 ! 00398 END SUBROUTINE WRITE_SURFX1_LFI 00399 ! 00400 ! ############################################################# 00401 SUBROUTINE WRITE_SURFX2_LFI(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00402 ! ############################################################# 00403 ! 00404 !!**** * - routine to fill a write 2D array for the externalised surface 00405 ! 00406 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00407 ! 00408 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI, NMASK, NFULL, & 00409 LMNH_COMPATIBLE, NIU, NIB, NIE, NJU, NJB, NJE 00410 ! 00411 USE MODI_IO_BUFF_n 00412 USE MODI_FMWRIT 00413 USE MODI_ERROR_WRITE_SURF_LFI 00414 USE MODI_GATHER_AND_WRITE_MPI 00415 USE MODI_GET_SURF_UNDEF 00416 ! 00417 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00418 USE PARKIND1 ,ONLY : JPRB 00419 ! 00420 IMPLICIT NONE 00421 ! 00422 #ifndef NOMPI 00423 INCLUDE "mpif.h" 00424 #endif 00425 ! 00426 !* 0.1 Declarations of arguments 00427 ! 00428 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00429 REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field 00430 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00431 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00432 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00433 ! 'H' : field with 00434 ! horizontal spatial dim. 00435 ! '-' : no horizontal dim. 00436 !* 0.2 Declarations of local variables 00437 ! 00438 LOGICAL :: GKNOWN 00439 DOUBLE PRECISION :: XTIME0 00440 REAL :: ZUNDEF ! default value 00441 REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2)) :: ZWORK ! work array read in the file 00442 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00443 ! 00444 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI',0,ZHOOK_HANDLE) 00445 ! 00446 KRESP=0 00447 ! 00448 !$OMP SINGLE 00449 ! 00450 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00451 ! 00452 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00453 ! 00454 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI',1,ZHOOK_HANDLE) 00455 IF (GKNOWN) RETURN 00456 ! 00457 IF (HDIR=='H') CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK) 00458 ! 00459 IF (NRANK==NPIO) THEN 00460 ! 00461 #ifndef NOMPI 00462 XTIME0 = MPI_WTIME() 00463 #endif 00464 ! 00465 !$OMP SINGLE 00466 ! 00467 IF (HDIR=='H') THEN 00468 ! 00469 CALL GET_SURF_UNDEF(ZUNDEF) 00470 ! 00471 IF (.NOT. LMNH_COMPATIBLE) THEN 00472 CALL FMWRITX2(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(ZWORK),ZWORK,4,100,HCOMMENT,KRESP) 00473 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00474 ELSE 00475 CALL WRITE_IN_LFI_X2_FOR_MNH(HREC,ZWORK,KRESP,HCOMMENT) 00476 END IF 00477 ! 00478 ELSE 00479 CALL FMWRITX2(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(PFIELD),PFIELD,4,100,HCOMMENT,KRESP) 00480 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00481 END IF 00482 ! 00483 !$OMP END SINGLE COPYPRIVATE(KRESP) 00484 ! 00485 #ifndef NOMPI 00486 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00487 #endif 00488 ! 00489 ENDIF 00490 ! 00491 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI',1,ZHOOK_HANDLE) 00492 ! 00493 CONTAINS 00494 ! 00495 ! ############################################################# 00496 SUBROUTINE WRITE_IN_LFI_X2_FOR_MNH(HREC,PFIELD,KRESP,HCOMMENT) 00497 ! ############################################################# 00498 ! 00499 !!**** * - routine to fill a write 2D array for the externalised surface 00500 ! 00501 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00502 USE PARKIND1 ,ONLY : JPRB 00503 ! 00504 IMPLICIT NONE 00505 ! 00506 !* 0.1 Declarations of arguments 00507 ! 00508 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00509 REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field 00510 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00511 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00512 ! 00513 !* 0.2 Declarations of local variables 00514 ! 00515 INTEGER :: JI, JJ 00516 REAL :: ZUNDEF 00517 REAL, DIMENSION(NIU,NJU,SIZE(PFIELD,2)) :: ZWORK3D ! work array read in a MNH file 00518 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00519 ! 00520 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI:WRITE_IN_LFI_X2_FOR_MNH',0,ZHOOK_HANDLE) 00521 ! 00522 CALL GET_SURF_UNDEF(ZUNDEF) 00523 ! 00524 ZWORK3D=ZUNDEF 00525 DO JJ=1,NJE-NJB+1 00526 DO JI=1,NIE-NIB+1 00527 ZWORK3D(NIB+JI-1,NJB+JJ-1,:) = PFIELD(JI+(NIE-NIB+1)*(JJ-1),:) 00528 END DO 00529 END DO 00530 ! 00531 IF (NJE==NJB) THEN 00532 CALL FMWRITX2(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(ZWORK3D,3)*NIU,ZWORK3D(:,NJE,:),4,100,HCOMMENT,KRESP) 00533 ELSEIF (NIE==NIB) THEN 00534 CALL FMWRITX2(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(ZWORK3D,3)*NJU,ZWORK3D(NIE,:,:),4,100,HCOMMENT,KRESP) 00535 ELSE 00536 CALL FMWRITX3(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(ZWORK3D),ZWORK3D,4,100,HCOMMENT,KRESP) 00537 ENDIF 00538 ! 00539 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00540 ! 00541 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI:WRITE_IN_LFI_X2_FOR_MNH',1,ZHOOK_HANDLE) 00542 END SUBROUTINE WRITE_IN_LFI_X2_FOR_MNH 00543 ! 00544 END SUBROUTINE WRITE_SURFX2_LFI 00545 ! 00546 ! ############################################################# 00547 SUBROUTINE WRITE_SURFN1_LFI(HREC,KFIELD,KRESP,HCOMMENT,HDIR) 00548 ! ############################################################# 00549 ! 00550 !!**** * - routine to write an integer array 00551 ! 00552 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00553 ! 00554 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI, NMASK, NFULL 00555 ! 00556 USE MODI_IO_BUFF_n 00557 USE MODI_FMWRIT 00558 USE MODI_ERROR_WRITE_SURF_LFI 00559 USE MODI_GATHER_AND_WRITE_MPI 00560 ! 00561 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00562 USE PARKIND1 ,ONLY : JPRB 00563 ! 00564 IMPLICIT NONE 00565 ! 00566 #ifndef NOMPI 00567 INCLUDE "mpif.h" 00568 #endif 00569 ! 00570 !* 0.1 Declarations of arguments 00571 ! 00572 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00573 INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD ! the integer to be read 00574 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00575 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00576 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00577 ! 'H' : field with 00578 ! horizontal spatial dim. 00579 ! '-' : no horizontal dim. 00580 !* 0.2 Declarations of local variables 00581 ! 00582 LOGICAL :: GKNOWN 00583 INTEGER, DIMENSION(MAX(NFULL,SIZE(KFIELD))) :: IWORK ! work array read in the file 00584 DOUBLE PRECISION :: XTIME0 00585 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00586 ! 00587 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFN1_LFI',0,ZHOOK_HANDLE) 00588 ! 00589 KRESP=0 00590 ! 00591 !$OMP SINGLE 00592 ! 00593 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00594 ! 00595 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00596 ! 00597 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFN1_LFI',1,ZHOOK_HANDLE) 00598 IF (GKNOWN) RETURN 00599 ! 00600 IF (HDIR=='H') CALL GATHER_AND_WRITE_MPI(KFIELD,IWORK,NMASK) 00601 ! 00602 IF (NRANK==NPIO) THEN 00603 ! 00604 #ifndef NOMPI 00605 XTIME0 = MPI_WTIME() 00606 #endif 00607 ! 00608 !$OMP SINGLE 00609 ! 00610 IF (HDIR=='H') THEN 00611 CALL FMWRITN1(CFILEOUT_LFI,HREC,CLUOUT_LFI,NFULL,IWORK,4,100,HCOMMENT,KRESP) 00612 ELSE 00613 CALL FMWRITN1(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(KFIELD),KFIELD,4,100,HCOMMENT,KRESP) 00614 END IF 00615 ! 00616 !$OMP END SINGLE COPYPRIVATE(KRESP) 00617 ! 00618 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00619 ! 00620 #ifndef NOMPI 00621 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00622 #endif 00623 ! 00624 ENDIF 00625 ! 00626 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFN1_LFI',1,ZHOOK_HANDLE) 00627 ! 00628 END SUBROUTINE WRITE_SURFN1_LFI 00629 ! 00630 ! ############################################################# 00631 SUBROUTINE WRITE_SURFL1_LFI(HREC,OFIELD,KRESP,HCOMMENT,HDIR) 00632 ! ############################################################# 00633 ! 00634 !!**** * - routine to write a logical array 00635 ! 00636 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00637 ! 00638 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI 00639 ! 00640 USE MODI_IO_BUFF_n 00641 USE MODI_GET_LUOUT 00642 USE MODI_FMWRIT 00643 USE MODI_ABOR1_SFX 00644 USE MODI_ERROR_WRITE_SURF_LFI 00645 ! 00646 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00647 USE PARKIND1 ,ONLY : JPRB 00648 ! 00649 IMPLICIT NONE 00650 ! 00651 #ifndef NOMPI 00652 INCLUDE "mpif.h" 00653 #endif 00654 ! 00655 !* 0.1 Declarations of arguments 00656 ! 00657 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00658 LOGICAL, DIMENSION(:), INTENT(IN) :: OFIELD ! array containing the data field 00659 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00660 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00661 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00662 ! 'H' : field with 00663 ! horizontal spatial dim. 00664 ! '-' : no horizontal dim. 00665 !* 0.2 Declarations of local variables 00666 ! 00667 INTEGER :: ILUOUT ! listing logical unit 00668 LOGICAL :: GKNOWN 00669 DOUBLE PRECISION :: XTIME0 00670 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00671 ! 00672 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFL1_LFI',0,ZHOOK_HANDLE) 00673 ! 00674 KRESP=0 00675 ! 00676 IF (NRANK==NPIO) THEN 00677 ! 00678 #ifndef NOMPI 00679 XTIME0 = MPI_WTIME() 00680 #endif 00681 ! 00682 !$OMP SINGLE 00683 ! 00684 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00685 ! 00686 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00687 ! 00688 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFL1_LFI',1,ZHOOK_HANDLE) 00689 IF (GKNOWN) RETURN 00690 ! 00691 IF (HDIR=='H') THEN 00692 CALL GET_LUOUT('LFI ',ILUOUT) 00693 WRITE(ILUOUT,*) 'Error: 1D logical vector for writing on an horizontal grid:' 00694 WRITE(ILUOUT,*) 'this option is not coded in WRITE_SURFL1_LFI' 00695 CALL ABOR1_SFX('MODE_WRITE_SURF_LFI: 1D LOGICAL VECTOR FOR WRITING NOT CODED IN WRITE_SURFL1_LFI') 00696 ELSE 00697 ! 00698 !$OMP SINGLE 00699 ! 00700 CALL FMWRITL1(CFILEOUT_LFI,HREC,CLUOUT_LFI,SIZE(OFIELD),OFIELD,4,100,HCOMMENT,KRESP) 00701 ! 00702 !$OMP END SINGLE COPYPRIVATE(KRESP) 00703 ! 00704 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00705 END IF 00706 ! 00707 #ifndef NOMPI 00708 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00709 #endif 00710 ! 00711 ENDIF 00712 ! 00713 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFL1_LFI',1,ZHOOK_HANDLE) 00714 ! 00715 END SUBROUTINE WRITE_SURFL1_LFI 00716 ! 00717 ! ############################################################# 00718 SUBROUTINE WRITE_SURFT0_LFI(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00719 ! ############################################################# 00720 ! 00721 !!**** * - routine to write a date 00722 ! 00723 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI 00724 ! 00725 USE MODI_IO_BUFF_n 00726 USE MODI_GET_SURF_UNDEF 00727 USE MODI_FMWRIT 00728 USE MODI_ERROR_WRITE_SURF_LFI 00729 ! 00730 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00731 USE PARKIND1 ,ONLY : JPRB 00732 ! 00733 IMPLICIT NONE 00734 ! 00735 !* 0.1 Declarations of arguments 00736 ! 00737 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00738 INTEGER, INTENT(IN) :: KYEAR ! year 00739 INTEGER, INTENT(IN) :: KMONTH ! month 00740 INTEGER, INTENT(IN) :: KDAY ! day 00741 REAL, INTENT(IN) :: PTIME ! time 00742 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00743 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00744 00745 !* 0.2 Declarations of local variables 00746 ! 00747 CHARACTER(LEN=12) :: YREC ! Name of the article to be written 00748 LOGICAL :: GKNOWN 00749 INTEGER, DIMENSION(3) :: ITDATE 00750 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00751 ! 00752 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFT0_LFI',0,ZHOOK_HANDLE) 00753 ! 00754 KRESP=0 00755 ! 00756 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00757 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFT0_LFI',1,ZHOOK_HANDLE) 00758 IF (GKNOWN) RETURN 00759 ! 00760 ITDATE(1) = KYEAR 00761 ITDATE(2) = KMONTH 00762 ITDATE(3) = KDAY 00763 ! 00764 YREC=TRIM(HREC)//'%TDATE' 00765 CALL FMWRITN1(CFILEOUT_LFI,YREC,CLUOUT_LFI,3,ITDATE,4,100,HCOMMENT,KRESP) 00766 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00767 ! 00768 YREC=TRIM(HREC)//'%TIME' 00769 CALL FMWRITX0(CFILEOUT_LFI,YREC,CLUOUT_LFI,1,PTIME,4,100,HCOMMENT,KRESP) 00770 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00771 ! 00772 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFT0_LFI',1,ZHOOK_HANDLE) 00773 ! 00774 END SUBROUTINE WRITE_SURFT0_LFI 00775 ! 00776 ! ############################################################# 00777 SUBROUTINE WRITE_SURFT1_LFI(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00778 ! ############################################################# 00779 ! 00780 !!**** * - routine to write a date 00781 ! 00782 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00783 ! 00784 USE MODD_IO_SURF_LFI, ONLY : CFILEOUT_LFI, CLUOUT_LFI 00785 ! 00786 ! 00787 USE MODI_IO_BUFF_n 00788 USE MODI_FMWRIT 00789 USE MODI_ERROR_WRITE_SURF_LFI 00790 ! 00791 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00792 USE PARKIND1 ,ONLY : JPRB 00793 ! 00794 IMPLICIT NONE 00795 ! 00796 #ifndef NOMPI 00797 INCLUDE "mpif.h" 00798 #endif 00799 ! 00800 !* 0.1 Declarations of arguments 00801 ! 00802 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00803 INTEGER, DIMENSION(:), INTENT(IN) :: KYEAR ! year 00804 INTEGER, DIMENSION(:), INTENT(IN) :: KMONTH ! month 00805 INTEGER, DIMENSION(:), INTENT(IN) :: KDAY ! day 00806 REAL, DIMENSION(:), INTENT(IN) :: PTIME ! time 00807 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00808 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00809 00810 !* 0.2 Declarations of local variables 00811 ! 00812 CHARACTER(LEN=12) :: YREC ! Name of the article to be written 00813 LOGICAL :: GKNOWN 00814 INTEGER, DIMENSION(3,SIZE(KYEAR)) :: ITDATE 00815 DOUBLE PRECISION :: XTIME0 00816 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00817 ! 00818 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFT1_LFI',0,ZHOOK_HANDLE) 00819 ! 00820 IF (NRANK==NPIO) THEN 00821 ! 00822 #ifndef NOMPI 00823 XTIME0 = MPI_WTIME() 00824 #endif 00825 ! 00826 KRESP=0 00827 ! 00828 !$OMP SINGLE 00829 ! 00830 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00831 ! 00832 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00833 ! 00834 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFT1_LFI',1,ZHOOK_HANDLE) 00835 IF (GKNOWN) RETURN 00836 ! 00837 !$OMP SINGLE 00838 ! 00839 ITDATE(1,:) = KYEAR (:) 00840 ITDATE(2,:) = KMONTH(:) 00841 ITDATE(3,:) = KDAY (:) 00842 ! 00843 YREC=TRIM(HREC)//'%TDATE' 00844 CALL FMWRITN2(CFILEOUT_LFI,YREC,CLUOUT_LFI,SIZE(ITDATE),ITDATE,4,100,HCOMMENT,KRESP) 00845 ! 00846 YREC=TRIM(HREC)//'%TIME' 00847 CALL FMWRITX1(CFILEOUT_LFI,YREC,CLUOUT_LFI,SIZE(PTIME),PTIME,4,100,HCOMMENT,KRESP) 00848 ! 00849 !$OMP END SINGLE COPYPRIVATE(KRESP) 00850 ! 00851 CALL ERROR_WRITE_SURF_LFI(HREC,KRESP) 00852 ! 00853 #ifndef NOMPI 00854 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00855 #endif 00856 ! 00857 ENDIF 00858 ! 00859 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_LFI:WRITE_SURFT1_LFI',1,ZHOOK_HANDLE) 00860 ! 00861 END SUBROUTINE WRITE_SURFT1_LFI 00862 ! 00863 END MODULE MODE_WRITE_SURF_LFI
1.8.0
