|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######spl 00002 SUBROUTINE FMWRITL1(HFILEM,HRECFM,HFIPRI,KLENG,OFIELD,KGRID,& 00003 KLENCH,HCOMMENT,KRESP) 00004 USE PARKIND1, ONLY : JPRB 00005 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00006 ! ############################################################# 00007 ! 00008 !!**** *FMWRITL0* - routine to write a logical scalar into a "FM"-file 00009 !! 00010 !! PURPOSE 00011 !! ------- 00012 ! 00013 ! The purpose of FMWRITN0 is to convert the integer into integer(kind=8) 00014 ! by calling FM_WRIT without interface module 00015 ! 00016 !!** METHOD 00017 !! ------ 00018 !! 00019 !! EXTERNAL 00020 !! -------- 00021 !! 00022 !! FM_WRIT 00023 !! 00024 !! IMPLICIT ARGUMENTS 00025 !! ------------------ 00026 !! 00027 !! 00028 !! REFERENCE 00029 !! --------- 00030 !! 00031 !! 00032 !! AUTHOR 00033 !! ------ 00034 !! 00035 !! V. MASSON *METEO-FRANCE* 00036 !! 00037 !! MODIFICATIONS 00038 !! ------------- 00039 !! 00040 !! original 06/08/97 00041 !---------------------------------------------------------------------------- 00042 ! 00043 !* 0. DECLARATIONS 00044 ! ------------ 00045 ! 00046 IMPLICIT NONE 00047 ! 00048 !* 0.1 Declarations of arguments 00049 ! 00050 CHARACTER(LEN=*) ,INTENT(IN) ::HFILEM ! file name 00051 CHARACTER(LEN=*) ,INTENT(IN) ::HRECFM ! name of the article to be written 00052 00053 CHARACTER(LEN=*) ,INTENT(IN) ::HFIPRI ! file for prints in FM 00054 00055 INTEGER, INTENT(IN) ::KLENG ! length of the data field 00056 LOGICAL, DIMENSION(:), 00057 INTENT(IN) ::OFIELD ! array containing the data field 00058 INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T) 00059 INTEGER, INTENT(IN) ::KLENCH ! length of comment string 00060 00061 CHARACTER(LEN=*) ,INTENT(IN) ::HCOMMENT ! comment string 00062 00063 INTEGER, INTENT(OUT)::KRESP ! return-code if problems araised 00064 ! 00065 !* 0.2 Declarations of local variables 00066 ! 00067 INTEGER(KIND=8), DIMENSION(SIZE(OFIELD)) :: IFIELD 00068 !------------------------------------------------------------------------------- 00069 ! 00070 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00071 IF (LHOOK) CALL DR_HOOK('FMWRITL1',0,ZHOOK_HANDLE) 00072 WHERE (OFIELD) 00073 IFIELD=1 00074 ELSEWHERE 00075 IFIELD=0 00076 END WHERE 00077 ! 00078 CALL FM_WRIT(HFILEM,HRECFM,HFIPRI,SIZE(IFIELD),IFIELD,KGRID,KLENCH,HCOMMENT,KRESP) 00079 !------------------------------------------------------------------------------- 00080 IF (LHOOK) CALL DR_HOOK('FMWRITL1',1,ZHOOK_HANDLE) 00081 END SUBROUTINE FMWRITL1
1.8.0
