SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE WRITE_DIAG_MISC_FLAKE_n(HPROGRAM) 00003 ! ################################# 00004 ! 00005 !!**** *WRITE_DIAG_MISC_FLAKE* - writes the FLAKE diagnostic fields 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! 00011 !!** METHOD 00012 !! ------ 00013 !! 00014 !! REFERENCE 00015 !! --------- 00016 !! 00017 !! 00018 !! AUTHOR 00019 !! ------ 00020 !! P. Le Moigne *Meteo France* 00021 !! 00022 !! MODIFICATIONS 00023 !! ------------- 00024 !! Original 10/2004 00025 !------------------------------------------------------------------------------- 00026 ! 00027 !* 0. DECLARATIONS 00028 ! ------------ 00029 USE MODI_INIT_IO_SURF_n 00030 USE MODI_WRITE_SURF 00031 USE MODI_END_IO_SURF_n 00032 !USE MODD_FLAKE_n 00033 USE MODD_DIAG_MISC_FLAKE_n,ONLY : LWATER_PROFILE, XZW_PROFILE, XTW_PROFILE 00034 ! 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 ! 00044 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling 00045 ! 00046 !* 0.2 Declarations of local variables 00047 ! ------------------------------- 00048 ! 00049 INTEGER :: IRESP ! IRESP : return-code if a problem appears 00050 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00051 CHARACTER(LEN=100):: YCOMMENT ! Comment string 00052 INTEGER :: IZ 00053 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00054 ! 00055 !------------------------------------------------------------------------------- 00056 ! 00057 ! Initialisation for IO 00058 ! 00059 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_FLAKE_N',0,ZHOOK_HANDLE) 00060 CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','FLAKE ','WRITE') 00061 ! 00062 !------------------------------------------------------------------------------- 00063 ! 00064 IF (LWATER_PROFILE) THEN 00065 ! 00066 !* Miscellaneous fields : 00067 ! ---------------------- 00068 DO IZ=1,SIZE(XZW_PROFILE) 00069 WRITE(YRECFM,'(F5.1)') XZW_PROFILE(IZ) 00070 YRECFM='TW_'//TRIM(ADJUSTL(YRECFM)) 00071 YCOMMENT='X_Y_'//YRECFM//' (K)' 00072 ! 00073 CALL WRITE_SURF(HPROGRAM,YRECFM,XTW_PROFILE(IZ,:),IRESP,HCOMMENT=YCOMMENT) 00074 END DO 00075 ! 00076 ! 00077 END IF 00078 ! 00079 !------------------------------------------------------------------------------- 00080 ! 00081 ! End of IO 00082 ! 00083 CALL END_IO_SURF_n(HPROGRAM) 00084 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_FLAKE_N',1,ZHOOK_HANDLE) 00085 ! 00086 END SUBROUTINE WRITE_DIAG_MISC_FLAKE_n