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