|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE INIT_WRITE_BIN(HREC,KPATCH,OWFL) 00003 ! ###################### 00004 ! 00005 !!**** *INIT_WRITE_BIN_n* Initialize array name to be written and associated 00006 !! unit number 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 ! 00011 !! 00012 !!** IMPLICIT ARGUMENTS 00013 !! ------------------ 00014 !! None 00015 !! 00016 !! REFERENCE 00017 !! --------- 00018 !! 00019 !! AUTHOR 00020 !! ------ 00021 !! A. LEMONSU *Meteo France* 00022 !! 00023 !! MODIFICATIONS 00024 !! ------------- 00025 !! 00026 ! 00027 !* 0. DECLARATIONS 00028 ! ------------ 00029 ! 00030 ! 00031 USE MODD_IO_SURF_BIN,ONLY:NMASK, NFULL, CMASK 00032 USE MODD_WRITE_BIN, ONLY:NUNIT0, NVAR, CVAR, JPVAR, NIND 00033 USE MODD_SURF_ATM_n, ONLY:NDIM_FULL 00034 USE MODD_DIAG_SURF_ATM_n, ONLY:LSELECT, CSELECT 00035 USE MODD_ISBA_n, ONLY:NPATCH 00036 ! 00037 USE MODI_ABOR1_SFX 00038 USE MODI_TEST_RECORD_LEN 00039 ! 00040 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00041 USE PARKIND1 ,ONLY : JPRB 00042 ! 00043 IMPLICIT NONE 00044 ! 00045 CHARACTER(LEN=12), INTENT(IN) :: HREC 00046 INTEGER, INTENT(IN) :: KPATCH 00047 LOGICAL, INTENT(INOUT) :: OWFL 00048 INTEGER :: IP, IVAR, IFIELD, JFIELD 00049 INTEGER :: IRECLEN 00050 LOGICAL :: LMATCH 00051 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00052 ! 00053 !------------------------------------------------------------------------------ 00054 IF (LHOOK) CALL DR_HOOK('INIT_WRITE_BIN',0,ZHOOK_HANDLE) 00055 IRECLEN=NDIM_FULL*KPATCH*4 00056 ! 00057 IVAR=NUNIT0 00058 DO IP=1, JPVAR 00059 IF (HREC==CVAR(IP)) THEN 00060 IVAR=NVAR(IP) 00061 EXIT 00062 ENDIF 00063 ENDDO 00064 ! 00065 ! 00066 IF (IVAR.NE.NUNIT0) THEN 00067 ! 00068 OWFL=.TRUE. 00069 ! 00070 ELSE 00071 ! 00072 IF (CVAR(1).NE.' ') IVAR=MAXVAL(NVAR(:)) 00073 ! 00074 ! 00075 IF (.NOT.LSELECT) THEN 00076 ! 00077 IF ( (HREC(1:2)/='D_' ) .AND. & 00078 (HREC(1:2)/='DX' ) .AND. & 00079 (HREC(1:2)/='DY' ) .AND. & 00080 (HREC(1:4)/='CLAY' ) .AND. & 00081 (HREC(1:4)/='SAND' ) .AND. & 00082 (HREC(1:2)/='ZS' ) .AND. & 00083 (HREC(1:4)/='SSO_' ) .AND. & 00084 (HREC(1:4)/='Q2M_' ) .AND. & 00085 (HREC(1:4)/='RESA' ) .AND. & 00086 (HREC(1:3)/='RI_' ) .AND. & 00087 (HREC(1:5)/='REG_L' ) .AND. & 00088 (HREC(1:3)/='AOS' ) .AND. & 00089 (HREC(1:3)/='HO2' ) .AND. & 00090 (HREC(1:3)/='RGL' ) .AND. & 00091 (HREC(1:3)/='SWD' ) .AND. & 00092 (HREC(1:3)/='SWU' ) .AND. & 00093 (HREC(1:3)/='LWD' ) .AND. & 00094 (HREC(1:3)/='LWU' ) .AND. & 00095 (HREC(1:3)/='ALB' ) .AND. & 00096 (HREC(1:2)/='DG' ) .AND. & 00097 (HREC(1:2)/='CV' ) .AND. & 00098 (HREC(1:5)/='GAMMA' ) .AND. & 00099 (HREC(1:5)/='RSMIN' ) .AND. & 00100 (HREC(1:5)/='WRMAX' ) .AND. & 00101 (HREC(1:5)/='Z0REL' ) .AND. & 00102 (HREC(1:5)/='Z0SEA' ) .AND. & 00103 (HREC(1:7)/='Z0WATER' ) .AND. & 00104 (HREC(4:6)/='_ZS' ) .AND. & 00105 (HREC(1:7)/='VEGTYPE' ) .AND. & 00106 (HREC(1:5)/='COVER' ) .AND. & 00107 (HREC(1:5)/='IRRIG' ) .AND. & 00108 (HREC(1:4)/='TI_R' ) .AND. & 00109 (HREC(1:3)/='CD_' ) .AND. & 00110 (HREC(1:3)/='CE_' ) .AND. & 00111 (HREC(1:3)/='CH_' ) .AND. & 00112 (HREC(1:4)/='FMU_' ) .AND. & 00113 (HREC(1:4)/='FMV_' ) .AND. & 00114 (HREC(1:5)/='DRAIN' ) .AND. & 00115 (HREC(1:4)/='EVAP' ) .AND. & 00116 (HREC(1:6)/='GFLUXC' ) .AND. & 00117 (HREC(1:6)/='GFLUX_' ) .AND. & 00118 (HREC(1:6)/='HORTON' ) .AND. & 00119 (HREC(1:6)/='RUNOFF' ) .AND. & 00120 (HREC(1:6)/='SNMELT' ) .AND. & 00121 (HREC(1:6)/='DRIVEG' ) .AND. & 00122 (HREC(1:2)/='Z0' ) ) THEN 00123 00124 IVAR = IVAR+1 00125 IF (IVAR-NUNIT0>JPVAR) THEN 00126 CALL ABOR1_SFX('TOO MANY FIELDS TO BE WRITTEN IN THE "BINARY" TYPE TIMESERIES') 00127 END IF 00128 CVAR(IVAR-NUNIT0) = HREC 00129 NVAR(IVAR-NUNIT0) = IVAR 00130 OPEN(UNIT=IVAR,FILE=TRIM(HREC)//'.BIN',FORM='UNFORMATTED',ACCESS='DIRECT',RECL=IRECLEN) 00131 OWFL=.TRUE. 00132 00133 ELSE 00134 OWFL=.FALSE. 00135 ENDIF 00136 ! 00137 ELSE 00138 ! 00139 IFIELD=0 00140 DO JFIELD=1,SIZE(CSELECT) 00141 IF (CSELECT(JFIELD)== ' ') EXIT 00142 IFIELD=IFIELD+1 00143 ENDDO 00144 00145 CALL TEST_RECORD_LEN("ASCII ",HREC,LMATCH) 00146 00147 IF (.NOT. LMATCH ) THEN 00148 00149 IVAR = IVAR+1 00150 IF (IVAR-NUNIT0>JPVAR) THEN 00151 CALL ABOR1_SFX('TOO MANY FIELDS TO BE WRITTEN IN THE "BINARY" TYPE TIMESERIES') 00152 END IF 00153 CVAR(IVAR-NUNIT0) = HREC 00154 NVAR(IVAR-NUNIT0) = IVAR 00155 OPEN(UNIT=IVAR,FILE=TRIM(HREC)//'.BIN',FORM='UNFORMATTED',ACCESS='DIRECT',RECL=IRECLEN) 00156 OWFL=.TRUE. 00157 00158 ELSE 00159 OWFL=.FALSE. 00160 ENDIF 00161 00162 ENDIF 00163 ENDIF 00164 00165 NIND=IVAR 00166 IF (LHOOK) CALL DR_HOOK('INIT_WRITE_BIN',1,ZHOOK_HANDLE) 00167 ! 00168 !------------------------------------------------------------------------------ 00169 ! 00170 END SUBROUTINE INIT_WRITE_BIN
1.8.0
