SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/init_write

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE INIT_WRITE_TXT(HREC,OWFL)
00003 !     ######################
00004 !
00005 !!****  *INIT_WRITE_TXT_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_TXT,ONLY:NMASK, NFULL, CMASK
00032 USE MODD_WRITE_TXT,  ONLY:NUNIT0, NVAR, CVAR, CVARN, JPVAR, NIND
00033 USE MODD_DIAG_SURF_ATM_n, ONLY:LSELECT, CSELECT
00034 !
00035 USE MODI_ABOR1_SFX
00036 USE MODI_TEST_RECORD_LEN
00037 !
00038 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00039 USE PARKIND1  ,ONLY : JPRB
00040 !
00041 IMPLICIT NONE
00042 !
00043  CHARACTER(LEN=12),   INTENT(IN)     :: HREC    
00044 LOGICAL,             INTENT(INOUT)  :: OWFL
00045 INTEGER                             :: IP, IVAR, IFIELD, JFIELD
00046 LOGICAL                             :: LMATCH
00047 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00048 !
00049 !------------------------------------------------------------------------------
00050 !
00051 IF (LHOOK) CALL DR_HOOK('INIT_WRITE_TXT',0,ZHOOK_HANDLE)
00052 !
00053 IVAR=NUNIT0
00054 DO IP=1, JPVAR
00055   IF (HREC==CVAR(IP)) THEN
00056     IVAR=NVAR(IP)
00057     EXIT
00058   ELSEIF(HREC==CVARN(IP)) THEN
00059     IVAR=-1
00060     EXIT
00061   ENDIF
00062 ENDDO
00063 !
00064 !
00065 IF (IVAR.LT.0) THEN
00066 !
00067   OWFL=.FALSE.
00068 !
00069 ELSEIF (IVAR.NE.NUNIT0) THEN
00070 !
00071   OWFL=.TRUE.
00072 !
00073 ELSE
00074 !
00075   IF (CVAR(1).NE.'                ') IVAR=MAXVAL(NVAR(:))
00076 !
00077 !
00078   IF (.NOT.LSELECT) THEN
00079 !
00080     IF ( (HREC(5:7)/='_OC'                          ) .AND.  & 
00081           (HREC(4:6)/='_OC'                          ) .AND.  &           
00082           (HREC(1:3)/='SEA'                          ) .AND.  &    
00083           (HREC(1:2)/='DX'                           ) .AND.  &
00084           (HREC(1:2)/='DY'                           ) .AND.  &
00085           (HREC(1:4)/='CLAY'                         ) .AND.  &
00086           (HREC(1:4)/='SAND'                         ) .AND.  &
00087           (HREC(1:2)/='ZS'                           ) .AND.  &
00088           (HREC(1:4)/='SSO_'                         ) .AND.  &
00089           (HREC(1:4)/='Q2M_'                         ) .AND.  &
00090           (HREC(1:4)/='RESA'                         ) .AND.  &
00091           (HREC(1:3)/='RI_'                          ) .AND.  &
00092           (HREC(1:5)/='REG_L'                        ) .AND.  &
00093           (HREC(1:3)/='AOS'                          ) .AND.  &
00094           (HREC(1:3)/='HO2'                          ) .AND.  &
00095           (HREC(1:3)/='RGL'                          ) .AND.  &
00096           (HREC(1:3)/='SWD'                          ) .AND.  &
00097           (HREC(1:3)/='SWU'                          ) .AND.  &
00098           (HREC(1:3)/='LWD'                          ) .AND.  &
00099           (HREC(1:3)/='LWU'                          ) .AND.  &
00100           (HREC(1:3)/='ALB'                          ) .AND.  &
00101           (HREC(1:2)/='DG'                           ) .AND.  &
00102           (HREC(1:5)/='DROOT'                        ) .AND.  &
00103           (HREC(1:4)/='DTOT'                         ) .AND.  &
00104           (HREC(1:7)/='RUNOFFD'                      ) .AND.  &
00105           (HREC(1:8)/='ROOTFRAC'                     ) .AND.  &
00106           (HREC(1:4)/='WSAT'                         ) .AND.  &
00107           (HREC(1:3)/='WFC'                          ) .AND.  &
00108           (HREC(1:3)/='W33'                          ) .AND.  &
00109           (HREC(1:5)/='WWILT'                        ) .AND.  &
00110           (HREC(1:4)/='DICE'                         ) .AND.  &
00111           (HREC(1:2)/='CV'                           ) .AND.  &
00112           (HREC(1:5)/='GAMMA'                        ) .AND.  &
00113           (HREC(1:5)/='RSMIN'                        ) .AND.  &
00114           (HREC(1:5)/='WRMAX'                        ) .AND.  &
00115           (HREC(1:5)/='Z0REL'                        ) .AND.  &
00116           (HREC(1:5)/='Z0SEA'                        ) .AND.  &
00117           (HREC(1:7)/='Z0WATER'                      ) .AND.  &
00118           (HREC(4:6)/='_ZS'                          ) .AND.  &
00119           (HREC(1:7)/='VEGTYPE'                      ) .AND.  &
00120           (HREC(1:5)/='COVER'                        ) .AND.  &
00121           (HREC(1:5)/='IRRIG'                        ) .AND.  &
00122           (HREC(1:4)/='TI_R'                         ) .AND.  &
00123           (HREC(1:3)/='CD_'                          ) .AND.  &
00124           (HREC(1:3)/='CE_'                          ) .AND.  &
00125           (HREC(1:3)/='CH_'                          ) .AND.  &
00126           (HREC(1:4)/='FMU_'                         ) .AND.  &
00127           (HREC(1:4)/='FMV_'                         ) .AND.  &
00128           (HREC(1:6)/='DRIVEG'                       ) .AND.  &
00129           (HREC(1:5)/='RRVEG'                        ) .AND.  &
00130           (HREC(1:8)/='BLD_DESC'                     ) .AND.  &
00131           (HREC(1:2)/='Z0'                           )        ) THEN  
00132 
00133       IVAR = IVAR+1
00134       IF (IVAR-NUNIT0>JPVAR) THEN
00135         CALL ABOR1_SFX('TOO MANY FIELDS TO BE WRITTEN IN THE "TEXTE" TYPE TIMESERIES')
00136       END IF
00137       CVAR(IVAR-NUNIT0) = HREC
00138       NVAR(IVAR-NUNIT0) = IVAR
00139       OPEN(UNIT=IVAR,FILE=TRIM(HREC)//'.TXT',FORM='FORMATTED')
00140       OWFL=.TRUE.
00141    
00142     ELSE
00143       IP = 1
00144       DO WHILE (CVARN(IP).NE.'                ') 
00145         IP=IP+1
00146       ENDDO
00147       CVARN(IP) = HREC
00148       OWFL=.FALSE.
00149     ENDIF
00150 !
00151   ELSE
00152 !        
00153     IFIELD=0
00154     DO JFIELD=1,SIZE(CSELECT)
00155       IF (CSELECT(JFIELD)== '            ') EXIT
00156       IFIELD=IFIELD+1
00157     ENDDO
00158   
00159     CALL TEST_RECORD_LEN("ASCII ",HREC,LMATCH)
00160 
00161     IF (.NOT. LMATCH ) THEN
00162 
00163       IVAR = IVAR+1
00164       IF (IVAR-NUNIT0>JPVAR) THEN
00165         CALL ABOR1_SFX('TOO MANY FIELDS TO BE WRITTEN IN THE "TEXTE" TYPE TIMESERIES')
00166       END IF
00167       CVAR(IVAR-NUNIT0) = HREC
00168       NVAR(IVAR-NUNIT0) = IVAR
00169       OPEN(UNIT=IVAR,FILE=TRIM(HREC)//'.TXT',FORM='FORMATTED')
00170       OWFL=.TRUE.
00171 
00172     ELSE
00173       OWFL=.FALSE.
00174     ENDIF
00175 
00176   ENDIF
00177 ENDIF
00178 
00179 NIND=IVAR
00180 IF (LHOOK) CALL DR_HOOK('INIT_WRITE_TXT',1,ZHOOK_HANDLE)
00181 !
00182 !------------------------------------------------------------------------------
00183 !
00184 END SUBROUTINE INIT_WRITE_TXT