SURFEX v7.3
General documentation of Surfex
|
00001 ! ######spl 00002 SUBROUTINE FMWRITC0(HFILEM,HRECFM,HFIPRI,KLENG,HFIELD,KGRID,& 00003 KLENCH,HCOMMENT,KRESP) 00004 USE PARKIND1, ONLY : JPRB 00005 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00006 ! ############################################################# 00007 ! 00008 !!**** *FMWRITC0* - routine to write a string scalar into a "FM"-file 00009 !! 00010 !! PURPOSE 00011 !! ------- 00012 ! 00013 ! The purpose of FMWRITL0 is to convert the string into arrayr of 00014 ! integer(kind=8) and to call 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 CHARACTER(LEN=*), & 00057 INTENT(IN) ::HFIELD ! 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 :: JLOOP 00068 INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: IFIELD 00069 INTEGER :: ILENG 00070 !------------------------------------------------------------------------------- 00071 ! 00072 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00073 IF (LHOOK) CALL DR_HOOK('FMWRITC0',0,ZHOOK_HANDLE) 00074 ILENG=LEN(HFIELD) 00075 ALLOCATE(IFIELD(ILENG)) 00076 DO JLOOP=1,ILENG 00077 IFIELD(JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP)) 00078 END DO 00079 ! 00080 CALL FM_WRIT(HFILEM,HRECFM,HFIPRI,ILENG,IFIELD,KGRID,KLENCH,HCOMMENT,KRESP) 00081 ! 00082 DEALLOCATE(IFIELD) 00083 !------------------------------------------------------------------------------- 00084 IF (LHOOK) CALL DR_HOOK('FMWRITC0',1,ZHOOK_HANDLE) 00085 END SUBROUTINE FMWRITC0