|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######spl 00002 MODULE MODE_WRITE_SURF_BIN 00003 ! 00004 INTERFACE WRITE_SURF0_BIN 00005 MODULE PROCEDURE WRITE_SURFX0_BIN 00006 MODULE PROCEDURE WRITE_SURFN0_BIN 00007 MODULE PROCEDURE WRITE_SURFL0_BIN 00008 MODULE PROCEDURE WRITE_SURFC0_BIN 00009 END INTERFACE 00010 INTERFACE WRITE_SURFN_BIN 00011 MODULE PROCEDURE WRITE_SURFX1_BIN 00012 MODULE PROCEDURE WRITE_SURFN1_BIN 00013 MODULE PROCEDURE WRITE_SURFL1_BIN 00014 MODULE PROCEDURE WRITE_SURFX2_BIN 00015 END INTERFACE 00016 INTERFACE WRITE_SURFT_BIN 00017 MODULE PROCEDURE WRITE_SURFT0_BIN 00018 MODULE PROCEDURE WRITE_SURFT2_BIN 00019 END INTERFACE 00020 ! 00021 CONTAINS 00022 ! 00023 ! ############################################################# 00024 SUBROUTINE WRITE_SURFX0_BIN(HREC,PFIELD,KRESP,HCOMMENT) 00025 ! ############################################################# 00026 ! 00027 !!**** * - routine to write a real scalar 00028 ! 00029 USE MODI_ERROR_WRITE_SURF_BIN 00030 ! 00031 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00032 USE PARKIND1 ,ONLY : JPRB 00033 ! 00034 IMPLICIT NONE 00035 ! 00036 !* 0.1 Declarations of arguments 00037 ! 00038 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00039 REAL, INTENT(IN) :: PFIELD ! the real scalar to be read 00040 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00041 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00042 ! 00043 !* 0.2 Declarations of local variables 00044 ! 00045 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00046 ! 00047 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFX0_BIN',0,ZHOOK_HANDLE) 00048 ! 00049 KRESP=0 00050 ! 00051 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00052 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00053 !plm WRITE(NUNIT,FMT=*,ERR=100) PFIELD 00054 00055 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFX0_BIN',1,ZHOOK_HANDLE) 00056 RETURN 00057 ! 00058 100 CONTINUE 00059 CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00060 ! 00061 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFX0_BIN',1,ZHOOK_HANDLE) 00062 ! 00063 END SUBROUTINE WRITE_SURFX0_BIN 00064 ! 00065 ! ############################################################# 00066 SUBROUTINE WRITE_SURFN0_BIN(HREC,KFIELD,KRESP,HCOMMENT) 00067 ! ############################################################# 00068 ! 00069 !!**** * - routine to write an integer 00070 ! 00071 USE MODI_ERROR_WRITE_SURF_BIN 00072 ! 00073 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00074 USE PARKIND1 ,ONLY : JPRB 00075 ! 00076 IMPLICIT NONE 00077 ! 00078 !* 0.1 Declarations of arguments 00079 ! 00080 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00081 INTEGER, INTENT(IN) :: KFIELD ! the integer to be read 00082 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00083 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00084 ! 00085 !* 0.2 Declarations of local variables 00086 ! 00087 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00088 ! 00089 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFN0_BIN',0,ZHOOK_HANDLE) 00090 ! 00091 KRESP=0 00092 ! 00093 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00094 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00095 !plm WRITE(NUNIT,FMT=*,ERR=100) KFIELD 00096 ! 00097 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFN0_BIN',1,ZHOOK_HANDLE) 00098 RETURN 00099 ! 00100 100 CONTINUE 00101 CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00102 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFN0_BIN',1,ZHOOK_HANDLE) 00103 ! 00104 END SUBROUTINE WRITE_SURFN0_BIN 00105 ! 00106 ! ############################################################# 00107 SUBROUTINE WRITE_SURFL0_BIN(HREC,OFIELD,KRESP,HCOMMENT) 00108 ! ############################################################# 00109 ! 00110 !!**** * - routine to write a logical 00111 ! 00112 USE MODI_ERROR_WRITE_SURF_BIN 00113 ! 00114 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00115 USE PARKIND1 ,ONLY : JPRB 00116 ! 00117 IMPLICIT NONE 00118 ! 00119 !* 0.1 Declarations of arguments 00120 ! 00121 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00122 LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field 00123 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00124 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00125 ! 00126 !* 0.2 Declarations of local variables 00127 ! 00128 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00129 ! 00130 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFL0_BIN',0,ZHOOK_HANDLE) 00131 ! 00132 KRESP=0 00133 ! 00134 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00135 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00136 !plm WRITE(NUNIT,FMT=*,ERR=100) OFIELD 00137 00138 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFL0_BIN',1,ZHOOK_HANDLE) 00139 RETURN 00140 ! 00141 100 CONTINUE 00142 CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00143 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFL0_BIN',1,ZHOOK_HANDLE) 00144 ! 00145 END SUBROUTINE WRITE_SURFL0_BIN 00146 ! 00147 ! ############################################################# 00148 SUBROUTINE WRITE_SURFC0_BIN(HREC,HFIELD,KRESP,HCOMMENT) 00149 ! ############################################################# 00150 ! 00151 !!**** * - routine to write a character 00152 ! 00153 USE MODI_ERROR_WRITE_SURF_BIN 00154 ! 00155 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00156 USE PARKIND1 ,ONLY : JPRB 00157 ! 00158 IMPLICIT NONE 00159 ! 00160 !* 0.1 Declarations of arguments 00161 ! 00162 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00163 CHARACTER(LEN=40), INTENT(IN) :: HFIELD ! the integer to be read 00164 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00165 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00166 ! 00167 !* 0.2 Declarations of local variables 00168 ! 00169 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00170 ! 00171 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFC0_BIN',0,ZHOOK_HANDLE) 00172 ! 00173 KRESP=0 00174 ! 00175 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00176 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00177 !plm WRITE(NUNIT,FMT='(A40)',ERR=100) HFIELD 00178 00179 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFC0_BIN',1,ZHOOK_HANDLE) 00180 RETURN 00181 ! 00182 100 CONTINUE 00183 CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00184 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFC0_BIN',1,ZHOOK_HANDLE) 00185 ! 00186 END SUBROUTINE WRITE_SURFC0_BIN 00187 ! 00188 ! ############################################################# 00189 SUBROUTINE WRITE_SURFX1_BIN(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00190 ! ############################################################# 00191 ! 00192 !!**** * - routine to fill a write 1D array for the externalised surface 00193 ! 00194 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00195 ! 00196 USE MODD_IO_SURF_BIN, ONLY : NMASK, NFULL, CMASK 00197 USE MODD_WRITE_BIN, ONLY : CVAR, NVAR, NIND, NWRITE 00198 ! 00199 USE MODI_ERROR_WRITE_SURF_BIN 00200 USE MODI_GATHER_AND_WRITE_MPI 00201 ! 00202 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00203 USE PARKIND1 ,ONLY : JPRB 00204 ! 00205 IMPLICIT NONE 00206 ! 00207 #ifndef NOMPI 00208 INCLUDE "mpif.h" 00209 #endif 00210 ! 00211 !* 0.1 Declarations of arguments 00212 ! 00213 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00214 REAL, DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field 00215 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00216 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00217 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00218 ! 'H' : field with 00219 ! horizontal spatial dim. 00220 ! '-' : no horizontal dim. 00221 !* 0.2 Declarations of local variables 00222 ! 00223 LOGICAL :: LWFL=.FALSE. 00224 REAL(KIND=4), DIMENSION(MAX(NFULL,SIZE(PFIELD))) :: ZWORK ! work array read in the file 00225 DOUBLE PRECISION :: XTIME0 00226 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00227 ! 00228 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFX1_BIN',0,ZHOOK_HANDLE) 00229 ! 00230 KRESP=0 00231 ! 00232 CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK) 00233 ! 00234 IF (NRANK==NPIO) THEN 00235 ! 00236 #ifndef NOMPI 00237 XTIME0 = MPI_WTIME() 00238 #endif 00239 ! 00240 !$OMP SINGLE 00241 ! 00242 CALL INIT_WRITE_BIN(HREC,1,LWFL) 00243 ! 00244 IF (LWFL) THEN 00245 WRITE(NIND,REC=NWRITE,IOSTAT=KRESP) ZWORK 00246 ENDIF 00247 ! 00248 IF (KRESP/=0) CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00249 ! 00250 !$OMP END SINGLE NOWAIT 00251 ! 00252 #ifndef NOMPI 00253 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00254 #endif 00255 ! 00256 ENDIF 00257 ! 00258 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFX1_BIN',1,ZHOOK_HANDLE) 00259 ! 00260 END SUBROUTINE WRITE_SURFX1_BIN 00261 ! 00262 ! ############################################################# 00263 SUBROUTINE WRITE_SURFX2_BIN(HREC,PFIELD,KRESP,HCOMMENT,HDIR) 00264 ! ############################################################# 00265 ! 00266 !!**** * - routine to fill a write 2D array for the externalised surface 00267 ! 00268 USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE 00269 ! 00270 USE MODD_IO_SURF_BIN, ONLY : NMASK, NFULL 00271 USE MODD_WRITE_BIN, ONLY : CVAR, NVAR, NIND, NWRITE 00272 ! 00273 USE MODI_ERROR_WRITE_SURF_BIN 00274 USE MODI_GATHER_AND_WRITE_MPI 00275 ! 00276 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00277 USE PARKIND1 ,ONLY : JPRB 00278 ! 00279 IMPLICIT NONE 00280 ! 00281 #ifndef NOMPI 00282 INCLUDE "mpif.h" 00283 #endif 00284 ! 00285 !* 0.1 Declarations of arguments 00286 ! 00287 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00288 REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field 00289 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00290 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00291 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00292 ! 'H' : field with 00293 ! horizontal spatial dim. 00294 ! '-' : no horizontal dim. 00295 !* 0.2 Declarations of local variables 00296 ! 00297 LOGICAL :: LWFL=.FALSE. 00298 REAL(KIND=4), DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2)) :: ZWORK ! work array read in the file 00299 DOUBLE PRECISION :: XTIME0 00300 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00301 ! 00302 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFX2_BIN',0,ZHOOK_HANDLE) 00303 ! 00304 KRESP=0 00305 ! 00306 CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK) 00307 ! 00308 IF (NRANK==NPIO) THEN 00309 ! 00310 #ifndef NOMPI 00311 XTIME0 = MPI_WTIME() 00312 #endif 00313 ! 00314 !$OMP SINGLE 00315 ! 00316 CALL INIT_WRITE_BIN(HREC,SIZE(PFIELD,2),LWFL) 00317 ! 00318 IF (LWFL) THEN 00319 WRITE(NIND,REC=NWRITE,IOSTAT=KRESP) ZWORK 00320 ENDIF 00321 ! 00322 IF (KRESP/=0) CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00323 ! 00324 !$OMP END SINGLE NOWAIT 00325 ! 00326 #ifndef NOMPI 00327 XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0) 00328 #endif 00329 ! 00330 ENDIF 00331 ! 00332 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFX2_BIN',1,ZHOOK_HANDLE) 00333 ! 00334 END SUBROUTINE WRITE_SURFX2_BIN 00335 ! 00336 ! ############################################################# 00337 SUBROUTINE WRITE_SURFN1_BIN(HREC,KFIELD,KRESP,HCOMMENT,HDIR) 00338 ! ############################################################# 00339 ! 00340 !!**** * - routine to write an integer array 00341 ! 00342 USE MODI_ERROR_WRITE_SURF_BIN 00343 ! 00344 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00345 USE PARKIND1 ,ONLY : JPRB 00346 ! 00347 IMPLICIT NONE 00348 ! 00349 !* 0.1 Declarations of arguments 00350 ! 00351 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00352 INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD ! the integer to be read 00353 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00354 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00355 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00356 ! 'H' : field with 00357 ! horizontal spatial dim. 00358 ! '-' : no horizontal dim. 00359 !* 0.2 Declarations of local variables 00360 ! 00361 !INTEGER, DIMENSION(NFULL) :: IWORK ! work array read in the file 00362 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00363 ! 00364 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFN1_BIN',0,ZHOOK_HANDLE) 00365 ! 00366 KRESP = 0 00367 ! 00368 !plm IF (HREC(1:8)=="EMISTIME") THEN 00369 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00370 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00371 !plm WRITE(NUNIT,FMT='(100I8)',ERR=100) KFIELD 00372 00373 !plm ELSE 00374 !plm CALL UNPACK_SAME_RANK(NMASK,KFIELD,IWORK(:)) 00375 00376 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00377 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00378 !plm WRITE(NUNIT,FMT='(100I8)',ERR=100) IWORK 00379 ! 00380 !plm ENDIF 00381 ! 00382 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFN1_BIN',1,ZHOOK_HANDLE) 00383 RETURN 00384 ! 00385 100 CONTINUE 00386 CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00387 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFN1_BIN',1,ZHOOK_HANDLE) 00388 ! 00389 END SUBROUTINE WRITE_SURFN1_BIN 00390 ! 00391 ! ############################################################# 00392 SUBROUTINE WRITE_SURFL1_BIN(HREC,OFIELD,KRESP,HCOMMENT,HDIR) 00393 ! ############################################################# 00394 ! 00395 !!**** * - routine to write a logical array 00396 ! 00397 USE MODI_ERROR_WRITE_SURF_BIN 00398 ! 00399 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00400 USE PARKIND1 ,ONLY : JPRB 00401 ! 00402 IMPLICIT NONE 00403 ! 00404 !* 0.1 Declarations of arguments 00405 ! 00406 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00407 LOGICAL, DIMENSION(:), INTENT(IN) :: OFIELD ! array containing the data field 00408 INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears 00409 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00410 CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field : 00411 ! 'H' : field with 00412 ! horizontal spatial dim. 00413 ! '-' : no horizontal dim. 00414 !* 0.2 Declarations of local variables 00415 ! 00416 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00417 ! 00418 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFL1_BIN',0,ZHOOK_HANDLE) 00419 ! 00420 KRESP=0 00421 ! 00422 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC 00423 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00424 !plm WRITE(NUNIT,FMT=*,ERR=100) OFIELD 00425 00426 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFL1_BIN',1,ZHOOK_HANDLE) 00427 RETURN 00428 ! 00429 100 CONTINUE 00430 CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00431 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFL1_BIN',1,ZHOOK_HANDLE) 00432 ! 00433 END SUBROUTINE WRITE_SURFL1_BIN 00434 ! 00435 ! ############################################################# 00436 SUBROUTINE WRITE_SURFT0_BIN(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00437 ! ############################################################# 00438 ! 00439 !!**** * - routine to write a date 00440 ! 00441 USE MODI_ERROR_WRITE_SURF_BIN 00442 ! 00443 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00444 USE PARKIND1 ,ONLY : JPRB 00445 ! 00446 IMPLICIT NONE 00447 ! 00448 !* 0.1 Declarations of arguments 00449 ! 00450 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00451 INTEGER, INTENT(IN) :: KYEAR ! year 00452 INTEGER, INTENT(IN) :: KMONTH ! month 00453 INTEGER, INTENT(IN) :: KDAY ! day 00454 REAL, INTENT(IN) :: PTIME ! time 00455 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00456 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00457 00458 !* 0.2 Declarations of local variables 00459 ! 00460 INTEGER, DIMENSION(3) :: ITDATE 00461 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00462 ! 00463 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFT0_BIN',0,ZHOOK_HANDLE) 00464 KRESP=0 00465 ! 00466 !plm ITDATE(1) = KYEAR 00467 !plm ITDATE(2) = KMONTH 00468 !plm ITDATE(3) = KDAY 00469 00470 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//TRIM(HREC)//'%TDATE' 00471 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00472 !plm WRITE(NUNIT,FMT=*,ERR=100) ITDATE(:) 00473 00474 !------------------------------------------------------------------------------- 00475 ! 00476 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//TRIM(HREC)//'%TIME' 00477 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00478 !plm WRITE(NUNIT,FMT=*,ERR=100) PTIME 00479 00480 !------------------------------------------------------------------------------- 00481 ! 00482 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFT0_BIN',1,ZHOOK_HANDLE) 00483 RETURN 00484 ! 00485 100 CONTINUE 00486 CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00487 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFT0_BIN',1,ZHOOK_HANDLE) 00488 ! 00489 END SUBROUTINE WRITE_SURFT0_BIN 00490 ! 00491 ! ############################################################# 00492 SUBROUTINE WRITE_SURFT2_BIN(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT) 00493 ! ############################################################# 00494 ! 00495 !!**** * - routine to write a date 00496 ! 00497 USE MODI_ERROR_WRITE_SURF_BIN 00498 ! 00499 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00500 USE PARKIND1 ,ONLY : JPRB 00501 ! 00502 IMPLICIT NONE 00503 ! 00504 !* 0.1 Declarations of arguments 00505 ! 00506 CHARACTER(LEN=12), INTENT(IN) :: HREC ! name of the article to be read 00507 INTEGER, DIMENSION(:,:), INTENT(IN) :: KYEAR ! year 00508 INTEGER, DIMENSION(:,:), INTENT(IN) :: KMONTH ! month 00509 INTEGER, DIMENSION(:,:), INTENT(IN) :: KDAY ! day 00510 REAL, DIMENSION(:,:), INTENT(IN) :: PTIME ! time 00511 INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears 00512 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string 00513 ! 00514 !* 0.2 Declarations of local variables 00515 ! 00516 INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE 00517 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00518 ! 00519 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFT2_BIN',0,ZHOOK_HANDLE) 00520 KRESP=0 00521 ! 00522 !plm ITDATE(1,:,:) = KYEAR (:,:) 00523 !plm ITDATE(2,:,:) = KMONTH (:,:) 00524 !plm ITDATE(3,:,:) = KDAY (:,:) 00525 00526 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//TRIM(HREC)//'%TDATE' 00527 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00528 !plm WRITE(NUNIT,FMT=*,ERR=100) ITDATE(:,:,:) 00529 00530 !------------------------------------------------------------------------------- 00531 ! 00532 !plm WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//TRIM(HREC)//'%TIME' 00533 !plm WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50) 00534 !plm WRITE(NUNIT,FMT=*,ERR=100) PTIME 00535 00536 !------------------------------------------------------------------------------- 00537 ! 00538 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFT2_BIN',1,ZHOOK_HANDLE) 00539 RETURN 00540 ! 00541 100 CONTINUE 00542 CALL ERROR_WRITE_SURF_BIN(HREC,KRESP) 00543 IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_BIN:WRITE_SURFT2_BIN',1,ZHOOK_HANDLE) 00544 ! 00545 END SUBROUTINE WRITE_SURFT2_BIN 00546 00547 END MODULE MODE_WRITE_SURF_BIN
1.8.0
