|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 MODULE MODE_WRITE_SURF_ASC 00002 ! 00003 INTERFACE WRITE_SURF0_ASC 00004 MODULE PROCEDURE WRITE_SURFX0_ASC 00005 MODULE PROCEDURE WRITE_SURFN0_ASC 00006 MODULE PROCEDURE WRITE_SURFL0_ASC 00007 MODULE PROCEDURE WRITE_SURFC0_ASC 00008 END INTERFACE 00009 INTERFACE WRITE_SURFN_ASC 00010 MODULE PROCEDURE WRITE_SURFX1_ASC 00011 MODULE PROCEDURE WRITE_SURFN1_ASC 00012 MODULE PROCEDURE WRITE_SURFL1_ASC 00013 MODULE PROCEDURE WRITE_SURFX2_ASC 00014 END INTERFACE 00015 INTERFACE WRITE_SURFT_ASC 00016 MODULE PROCEDURE WRITE_SURFT0_ASC 00017 MODULE PROCEDURE WRITE_SURFT1_ASC 00018 MODULE PROCEDURE WRITE_SURFT2_ASC 00019 END INTERFACE 00020 ! 00021 CONTAINS 00022 ! 00023 ! ############################################################# 00024 SUBROUTINE WRITE_SURFX0_ASC(HREC,PFIELD,KRESP,HCOMMENT) 00025 ! ############################################################# 00026 ! 00027 !!**** * - routine to write a real scalar 00028 ! 00029 USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK 00030 ! 00031 USE MODI_IO_BUFF_n 00032 USE MODI_ERROR_WRITE_SURF_ASC 00033 ! 00034 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00035 USE PARKIND1 ,ONLY : JPRB 00036 ! 00037 IMPLICIT NONE 00038 ! 00039 !* 0.1 Declarations of arguments 00040 ! 00041 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00042 REAL, INTENT(IN) :: PFIELD ! the real scalar to be read 00043 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00044 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00045 ! 00046 !* 0.2 Declarations of local variables 00047 ! 00048 LOGICAL :: GKNOWN 00049 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00050 ! 00051 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',0,ZHOOK_HANDLE) 00052 ! 00053 KRESP=0 00054 ! 00055 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00056 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE) 00057 IF (GKNOWN) RETURN 00058 ! 00059 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00060 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00061 WRITE(NUNIT,FMT=*,ERR=100) PFIELD 00062 ! 00063 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE) 00064 RETURN 00065 ! 00066 100 CONTINUE 00067 CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00068 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE) 00069 ! 00070 END SUBROUTINE WRITE_SURFX0_ASC 00071 ! 00072 ! ############################################################# 00073 SUBROUTINE WRITE_SURFN0_ASC(HREC,KFIELD,KRESP,HCOMMENT) 00074 ! ############################################################# 00075 ! 00076 !!**** * - routine to write an integer 00077 ! 00078 USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, CMASK 00079 ! 00080 USE MODI_IO_BUFF_n 00081 USE MODI_ERROR_WRITE_SURF_ASC 00082 ! 00083 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00084 USE PARKIND1 ,ONLY : JPRB 00085 ! 00086 IMPLICIT NONE 00087 ! 00088 !* 0.1 Declarations of arguments 00089 ! 00090 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00091 INTEGER, INTENT(IN) :: KFIELD ! the integer to be read 00092 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00093 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00094 ! 00095 !* 0.2 Declarations of local variables 00096 ! 00097 LOGICAL :: GKNOWN 00098 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00099 ! 00100 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',0,ZHOOK_HANDLE) 00101 ! 00102 KRESP=0 00103 ! 00104 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00105 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,ZHOOK_HANDLE) 00106 IF (GKNOWN) RETURN 00107 ! 00108 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00109 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00110 WRITE(NUNIT,FMT=*,ERR=100) KFIELD 00111 ! 00112 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,ZHOOK_HANDLE) 00113 RETURN 00114 ! 00115 100 CONTINUE 00116 CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00117 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,ZHOOK_HANDLE) 00118 ! 00119 END SUBROUTINE WRITE_SURFN0_ASC 00120 ! 00121 ! ############################################################# 00122 SUBROUTINE WRITE_SURFL0_ASC(HREC,OFIELD,KRESP,HCOMMENT) 00123 ! ############################################################# 00124 ! 00125 !!**** * - routine to write a logical 00126 ! 00127 USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK 00128 ! 00129 USE MODI_IO_BUFF_n 00130 USE MODI_ERROR_WRITE_SURF_ASC 00131 ! 00132 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00133 USE PARKIND1 ,ONLY : JPRB 00134 ! 00135 IMPLICIT NONE 00136 ! 00137 !* 0.1 Declarations of arguments 00138 ! 00139 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00140 LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field 00141 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00142 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00143 ! 00144 !* 0.2 Declarations of local variables 00145 ! 00146 LOGICAL :: GKNOWN 00147 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00148 ! 00149 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',0,ZHOOK_HANDLE) 00150 ! 00151 KRESP=0 00152 ! 00153 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00154 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,ZHOOK_HANDLE) 00155 IF (GKNOWN) RETURN 00156 ! 00157 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00158 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00159 WRITE(NUNIT,FMT=*,ERR=100) OFIELD 00160 ! 00161 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,ZHOOK_HANDLE) 00162 RETURN 00163 ! 00164 100 CONTINUE 00165 CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00166 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,ZHOOK_HANDLE) 00167 ! 00168 END SUBROUTINE WRITE_SURFL0_ASC 00169 ! 00170 ! ############################################################# 00171 SUBROUTINE WRITE_SURFC0_ASC(HREC,HFIELD,KRESP,HCOMMENT) 00172 ! ############################################################# 00173 ! 00174 !!**** * - routine to write a character 00175 ! 00176 USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK 00177 ! 00178 USE MODI_IO_BUFF_n 00179 USE MODI_ERROR_WRITE_SURF_ASC 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_ASC:WRITE_SURFC0_ASC',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_ASC:WRITE_SURFC0_ASC',1,ZHOOK_HANDLE) 00204 IF (GKNOWN) RETURN 00205 ! 00206 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00207 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00208 WRITE(NUNIT,FMT='(A40)',ERR=100) HFIELD 00209 ! 00210 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,ZHOOK_HANDLE) 00211 RETURN 00212 ! 00213 100 CONTINUE 00214 CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00215 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,ZHOOK_HANDLE) 00216 ! 00217 END SUBROUTINE WRITE_SURFC0_ASC 00218 ! 00219 ! ############################################################# 00220 SUBROUTINE WRITE_SURFX1_ASC(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00221 ! ############################################################# 00222 ! 00223 !!**** * - routine to fill a write 1D array for the externalised surface 00224 ! 00225 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE, WLOG_MPI 00226 ! 00227 USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, NFULL, CMASK 00228 ! 00229 USE MODI_IO_BUFF_n 00230 USE MODI_ERROR_WRITE_SURF_ASC 00231 USE MODI_GATHER_AND_WRITE_MPI 00232 ! 00233 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00234 USE PARKIND1 ,ONLY : JPRB 00235 ! 00236 IMPLICIT NONE 00237 ! 00238 #ifndef NOMPI 00239 INCLUDE "mpif.h" 00240 #endif 00241 ! 00242 !* 0.1 Declarations of arguments 00243 ! 00244 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00245 REAL, DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field 00246 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00247 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00248 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00249 ! 'H' : field with 00250 ! horizontal spatial dim. 00251 ! '-' : no horizontal dim. 00252 !* 0.2 Declarations of local variables 00253 ! 00254 INTEGER :: ISIZE, J 00255 LOGICAL :: GKNOWN 00256 DOUBLE PRECISION :: XTIME0 00257 REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD))) :: ZWORK ! work array read in the file 00258 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00259 ! 00260 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',0,ZHOOK_HANDLE) 00261 ! 00262 KRESP=0 00263 ! 00264 !$OMP SINGLE 00265 ! 00266 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00267 ! 00268 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00269 ! 00270 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',1,ZHOOK_HANDLE) 00271 IF (GKNOWN) RETURN 00272 ! 00273 IF (HDIR=='-') THEN 00274 ISIZE = SIZE(PFIELD) 00275 ZWORK(1:ISIZE) = PFIELD 00276 ELSE 00277 ISIZE = SIZE(ZWORK) 00278 CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK) 00279 ENDIF 00280 ! 00281 IF (NRANK==NPIO) THEN 00282 ! 00283 #ifndef NOMPI 00284 XTIME0 = MPI_WTIME() 00285 #endif 00286 ! 00287 !$OMP SINGLE 00288 ! 00289 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC 00290 WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50) 00291 WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=KRESP) ZWORK(1:ISIZE) 00292 ! 00293 !$OMP END SINGLE COPYPRIVATE(KRESP) 00294 ! 00295 IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00296 ! 00297 #ifndef NOMPI 00298 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00299 #endif 00300 ! 00301 ENDIF 00302 ! 00303 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',1,ZHOOK_HANDLE) 00304 ! 00305 END SUBROUTINE WRITE_SURFX1_ASC 00306 ! 00307 ! ############################################################# 00308 SUBROUTINE WRITE_SURFX2_ASC(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00309 ! ############################################################# 00310 ! 00311 !!**** * - routine to fill a write 2D array for the externalised surface 00312 ! 00313 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE, WLOG_MPI 00314 ! 00315 USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, NFULL, CMASK 00316 ! 00317 USE MODI_IO_BUFF_n 00318 USE MODI_ERROR_WRITE_SURF_ASC 00319 USE MODI_GATHER_AND_WRITE_MPI 00320 ! 00321 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00322 USE PARKIND1 ,ONLY : JPRB 00323 ! 00324 IMPLICIT NONE 00325 ! 00326 #ifndef NOMPI 00327 INCLUDE "mpif.h" 00328 #endif 00329 ! 00330 !* 0.1 Declarations of arguments 00331 ! 00332 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00333 REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field 00334 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00335 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00336 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00337 ! 'H' : field with 00338 ! horizontal spatial dim. 00339 ! '-' : no horizontal dim. 00340 !* 0.2 Declarations of local variables 00341 ! 00342 integer :: me 00343 INTEGER :: ISIZE 00344 LOGICAL :: GKNOWN=.FALSE. 00345 DOUBLE PRECISION :: XTIME0 00346 REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2)) :: ZWORK ! work array read in the file 00347 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00348 ! 00349 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',0,ZHOOK_HANDLE) 00350 ! 00351 KRESP=0 00352 ! 00353 !$OMP SINGLE 00354 ! 00355 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00356 ! 00357 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00358 ! 00359 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,ZHOOK_HANDLE) 00360 IF (GKNOWN) RETURN 00361 ! 00362 IF (HDIR=='-') THEN 00363 ISIZE = SIZE(PFIELD,1) 00364 ZWORK(1:ISIZE,:) = PFIELD(:,:) 00365 ELSE 00366 ISIZE = SIZE(ZWORK,1) 00367 CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK) 00368 ENDIF 00369 ! 00370 IF (NRANK==NPIO) THEN 00371 ! 00372 #ifndef NOMPI 00373 XTIME0 = MPI_WTIME() 00374 #endif 00375 ! 00376 !$OMP SINGLE 00377 ! 00378 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC 00379 WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50) 00380 WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=KRESP) ZWORK(1:ISIZE,:) 00381 ! 00382 !$OMP END SINGLE COPYPRIVATE(KRESP) 00383 ! 00384 IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00385 ! 00386 #ifndef NOMPI 00387 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00388 #endif 00389 ! 00390 ENDIF 00391 ! 00392 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,ZHOOK_HANDLE) 00393 ! 00394 END SUBROUTINE WRITE_SURFX2_ASC 00395 ! 00396 ! ############################################################# 00397 SUBROUTINE WRITE_SURFN1_ASC(HREC,KFIELD,KRESP,HCOMMENT,HDIR) 00398 ! ############################################################# 00399 ! 00400 !!**** * - routine to write an integer array 00401 ! 00402 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00403 ! 00404 USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, NFULL, CMASK 00405 ! 00406 USE MODI_IO_BUFF_n 00407 USE MODI_ERROR_WRITE_SURF_ASC 00408 USE MODI_GATHER_AND_WRITE_MPI 00409 ! 00410 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00411 USE PARKIND1 ,ONLY : JPRB 00412 ! 00413 IMPLICIT NONE 00414 ! 00415 #ifndef NOMPI 00416 INCLUDE "mpif.h" 00417 #endif 00418 ! 00419 !* 0.1 Declarations of arguments 00420 ! 00421 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00422 INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD ! the integer to be read 00423 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00424 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00425 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00426 ! 'H' : field with 00427 ! horizontal spatial dim. 00428 ! '-' : no horizontal dim. 00429 !* 0.2 Declarations of local variables 00430 ! 00431 INTEGER :: ISIZE 00432 LOGICAL :: GKNOWN 00433 INTEGER, DIMENSION(MAX(NFULL,SIZE(KFIELD))) :: IWORK ! work array read in the file 00434 DOUBLE PRECISION :: XTIME0 00435 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00436 ! 00437 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',0,ZHOOK_HANDLE) 00438 ! 00439 KRESP = 0 00440 ! 00441 !$OMP SINGLE 00442 ! 00443 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00444 ! 00445 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00446 ! 00447 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',1,ZHOOK_HANDLE) 00448 IF (GKNOWN) RETURN 00449 ! 00450 IF (HDIR=='-' .OR. HREC=='-') THEN 00451 ISIZE = SIZE(KFIELD) 00452 IWORK(1:ISIZE) = KFIELD 00453 ELSE 00454 ISIZE = SIZE(IWORK) 00455 CALL GATHER_AND_WRITE_MPI(KFIELD,IWORK,NMASK) 00456 ENDIF 00457 ! 00458 IF (NRANK==NPIO) THEN 00459 ! 00460 #ifndef NOMPI 00461 XTIME0 = MPI_WTIME() 00462 #endif 00463 ! 00464 !$OMP SINGLE 00465 ! 00466 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC 00467 WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50) 00468 WRITE(NUNIT,FMT='(100I8)',IOSTAT=KRESP) IWORK(1:ISIZE) 00469 ! 00470 !$OMP END SINGLE COPYPRIVATE(KRESP) 00471 ! 00472 IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00473 ! 00474 #ifndef NOMPI 00475 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00476 #endif 00477 ! 00478 ENDIF 00479 ! 00480 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',1,ZHOOK_HANDLE) 00481 ! 00482 END SUBROUTINE WRITE_SURFN1_ASC 00483 ! 00484 ! ############################################################# 00485 SUBROUTINE WRITE_SURFL1_ASC(HREC,OFIELD,KRESP,HCOMMENT,HDIR) 00486 ! ############################################################# 00487 ! 00488 !!**** * - routine to write a logical array 00489 ! 00490 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00491 ! 00492 USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK 00493 ! 00494 USE MODI_IO_BUFF_n 00495 USE MODI_ERROR_WRITE_SURF_ASC 00496 ! 00497 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00498 USE PARKIND1 ,ONLY : JPRB 00499 ! 00500 IMPLICIT NONE 00501 ! 00502 #ifndef NOMPI 00503 INCLUDE "mpif.h" 00504 #endif 00505 ! 00506 !* 0.1 Declarations of arguments 00507 ! 00508 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00509 LOGICAL, DIMENSION(:), INTENT(IN) :: OFIELD ! 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 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00513 ! 'H' : field with 00514 ! horizontal spatial dim. 00515 ! '-' : no horizontal dim. 00516 !* 0.2 Declarations of local variables 00517 ! 00518 LOGICAL :: GKNOWN 00519 DOUBLE PRECISION :: XTIME0 00520 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00521 ! 00522 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',0,ZHOOK_HANDLE) 00523 ! 00524 IF (NRANK==NPIO) THEN 00525 ! 00526 #ifndef NOMPI 00527 XTIME0 = MPI_WTIME() 00528 #endif 00529 ! 00530 KRESP=0 00531 ! 00532 !$OMP SINGLE 00533 ! 00534 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00535 ! 00536 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00537 ! 00538 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',1,ZHOOK_HANDLE) 00539 IF (GKNOWN) RETURN 00540 ! 00541 !$OMP SINGLE 00542 ! 00543 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC 00544 WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50) 00545 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) OFIELD 00546 ! 00547 !$OMP END SINGLE COPYPRIVATE(KRESP) 00548 ! 00549 IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00550 ! 00551 #ifndef NOMPI 00552 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00553 #endif 00554 ! 00555 ENDIF 00556 ! 00557 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',1,ZHOOK_HANDLE) 00558 ! 00559 END SUBROUTINE WRITE_SURFL1_ASC 00560 ! 00561 ! ############################################################# 00562 SUBROUTINE WRITE_SURFT0_ASC(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00563 ! ############################################################# 00564 ! 00565 !!**** * - routine to write a date 00566 ! 00567 USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK 00568 ! 00569 USE MODI_IO_BUFF_n 00570 USE MODI_ERROR_WRITE_SURF_ASC 00571 ! 00572 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00573 USE PARKIND1 ,ONLY : JPRB 00574 ! 00575 IMPLICIT NONE 00576 ! 00577 !* 0.1 Declarations of arguments 00578 ! 00579 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00580 INTEGER, INTENT(IN) :: KYEAR ! year 00581 INTEGER, INTENT(IN) :: KMONTH ! month 00582 INTEGER, INTENT(IN) :: KDAY ! day 00583 REAL, INTENT(IN) :: PTIME ! time 00584 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00585 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00586 00587 !* 0.2 Declarations of local variables 00588 ! 00589 LOGICAL :: GKNOWN 00590 INTEGER, DIMENSION(3) :: ITDATE 00591 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00592 ! 00593 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',0,ZHOOK_HANDLE) 00594 ! 00595 KRESP=0 00596 ! 00597 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00598 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,ZHOOK_HANDLE) 00599 IF (GKNOWN) RETURN 00600 ! 00601 ITDATE(1) = KYEAR 00602 ITDATE(2) = KMONTH 00603 ITDATE(3) = KDAY 00604 ! 00605 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//TRIM(HREC)//'%TDATE' 00606 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00607 WRITE(NUNIT,FMT=*,ERR=100) ITDATE(:) 00608 ! 00609 WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//TRIM(HREC)//'%TIME' 00610 WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00611 WRITE(NUNIT,FMT=*,ERR=100) PTIME 00612 ! 00613 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,ZHOOK_HANDLE) 00614 RETURN 00615 ! 00616 100 CONTINUE 00617 CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00618 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,ZHOOK_HANDLE) 00619 ! 00620 END SUBROUTINE WRITE_SURFT0_ASC 00621 ! 00622 ! ############################################################# 00623 SUBROUTINE WRITE_SURFT1_ASC(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00624 ! ############################################################# 00625 ! 00626 !!**** * - routine to write a date 00627 ! 00628 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00629 ! 00630 USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK 00631 ! 00632 USE MODI_IO_BUFF_n 00633 USE MODI_ERROR_WRITE_SURF_ASC 00634 ! 00635 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00636 USE PARKIND1 ,ONLY : JPRB 00637 ! 00638 IMPLICIT NONE 00639 ! 00640 #ifndef NOMPI 00641 INCLUDE "mpif.h" 00642 #endif 00643 ! 00644 !* 0.1 Declarations of arguments 00645 ! 00646 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00647 INTEGER, DIMENSION(:), INTENT(IN) :: KYEAR ! year 00648 INTEGER, DIMENSION(:), INTENT(IN) :: KMONTH ! month 00649 INTEGER, DIMENSION(:), INTENT(IN) :: KDAY ! day 00650 REAL, DIMENSION(:), INTENT(IN) :: PTIME ! time 00651 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00652 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00653 00654 !* 0.2 Declarations of local variables 00655 ! 00656 LOGICAL :: GKNOWN 00657 INTEGER, DIMENSION(3,SIZE(KYEAR)) :: ITDATE 00658 DOUBLE PRECISION :: XTIME0 00659 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00660 ! 00661 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',0,ZHOOK_HANDLE) 00662 ! 00663 IF (NRANK==NPIO) THEN 00664 ! 00665 #ifndef NOMPI 00666 XTIME0 = MPI_WTIME() 00667 #endif 00668 ! 00669 KRESP=0 00670 ! 00671 !$OMP SINGLE 00672 ! 00673 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00674 ! 00675 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00676 ! 00677 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',1,ZHOOK_HANDLE) 00678 IF (GKNOWN) RETURN 00679 ! 00680 !$OMP SINGLE 00681 ! 00682 ITDATE(1,:) = KYEAR (:) 00683 ITDATE(2,:) = KMONTH (:) 00684 ITDATE(3,:) = KDAY (:) 00685 ! 00686 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//TRIM(HREC)//'%TDATE' 00687 WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50) 00688 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) ITDATE(:,:) 00689 ! 00690 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//TRIM(HREC)//'%TIME' 00691 WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50) 00692 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) PTIME 00693 ! 00694 !$OMP END SINGLE COPYPRIVATE(KRESP) 00695 ! 00696 IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00697 ! 00698 #ifndef NOMPI 00699 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00700 #endif 00701 ! 00702 ENDIF 00703 ! 00704 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',1,ZHOOK_HANDLE) 00705 ! 00706 END SUBROUTINE WRITE_SURFT1_ASC 00707 ! 00708 ! ############################################################# 00709 SUBROUTINE WRITE_SURFT2_ASC(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00710 ! ############################################################# 00711 ! 00712 !!**** * - routine to write a date 00713 ! 00714 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00715 ! 00716 USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK 00717 ! 00718 USE MODI_IO_BUFF_n 00719 USE MODI_ERROR_WRITE_SURF_ASC 00720 ! 00721 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00722 USE PARKIND1 ,ONLY : JPRB 00723 ! 00724 IMPLICIT NONE 00725 ! 00726 #ifndef NOMPI 00727 INCLUDE "mpif.h" 00728 #endif 00729 ! 00730 !* 0.1 Declarations of arguments 00731 ! 00732 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00733 INTEGER, DIMENSION(:,:), INTENT(IN) :: KYEAR ! year 00734 INTEGER, DIMENSION(:,:), INTENT(IN) :: KMONTH ! month 00735 INTEGER, DIMENSION(:,:), INTENT(IN) :: KDAY ! day 00736 REAL, DIMENSION(:,:), INTENT(IN) :: PTIME ! time 00737 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00738 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00739 00740 !* 0.2 Declarations of local variables 00741 ! 00742 LOGICAL :: GKNOWN 00743 INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE 00744 DOUBLE PRECISION :: XTIME0 00745 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00746 ! 00747 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',0,ZHOOK_HANDLE) 00748 ! 00749 IF (NRANK==NPIO) THEN 00750 ! 00751 #ifndef NOMPI 00752 XTIME0 = MPI_WTIME() 00753 #endif 00754 ! 00755 KRESP=0 00756 ! 00757 !$OMP SINGLE 00758 ! 00759 CALL IO_BUFF_n(HREC,'W',GKNOWN) 00760 ! 00761 !$OMP END SINGLE COPYPRIVATE(GKNOWN) 00762 ! 00763 IF (GKNOWN .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',1,ZHOOK_HANDLE) 00764 IF (GKNOWN) RETURN 00765 ! 00766 !$OMP SINGLE 00767 ! 00768 ITDATE(1,:,:) = KYEAR (:,:) 00769 ITDATE(2,:,:) = KMONTH (:,:) 00770 ITDATE(3,:,:) = KDAY (:,:) 00771 ! 00772 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//TRIM(HREC)//'%TDATE' 00773 WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50) 00774 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) ITDATE(:,:,:) 00775 ! 00776 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//TRIM(HREC)//'%TIME' 00777 WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50) 00778 WRITE(NUNIT,FMT=*,IOSTAT=KRESP) PTIME 00779 ! 00780 !$OMP END SINGLE 00781 ! 00782 IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP) 00783 ! 00784 #ifndef NOMPI 00785 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00786 #endif 00787 ! 00788 ENDIF 00789 ! 00790 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',1,ZHOOK_HANDLE) 00791 ! 00792 END SUBROUTINE WRITE_SURFT2_ASC 00793 ! 00794 END MODULE MODE_WRITE_SURF_ASC
1.8.0
