SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/mode_read

Go to the documentation of this file.
00001 MODULE MODE_READ_CDF
00002 !===================================================================
00003 !
00004 !
00005 USE MODI_ABOR1_SFX
00006 !
00007 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00008 USE PARKIND1  ,ONLY : JPRB
00009 !
00010 CONTAINS
00011 !-------------------------------------------------------------------
00012 !-------------------------------------------------------------------
00013 !     ####################
00014       SUBROUTINE HANDLE_ERR_CDF(status,line)
00015 !     ####################
00016 IMPLICIT NONE
00017 INTEGER, INTENT(IN)           :: status
00018  CHARACTER(*), INTENT(IN) :: line
00019 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00020 !
00021 include 'netcdf.inc'
00022 !
00023 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:HANDLE_ERR_CDF',0,ZHOOK_HANDLE)
00024 IF (status /= NF_NOERR) THEN
00025   CALL ABOR1_SFX('MODE_READ_NETCDF: HANDLE_ERR_CDF:'//TRIM(line))
00026 END IF
00027 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:HANDLE_ERR_CDF',1,ZHOOK_HANDLE)
00028 END SUBROUTINE HANDLE_ERR_CDF
00029 !-------------------------------------------------------------------
00030 !-------------------------------------------------------------------
00031 !     ####################
00032       SUBROUTINE GET1DCDF(KCDF_ID,IDVAR,PMISSVALUE,PVALU1D)
00033 !     ####################
00034 !
00035 IMPLICIT NONE
00036 !
00037 INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
00038 INTEGER,INTENT(IN) :: IDVAR   !variable to read identifiant
00039 REAL, INTENT(OUT) ::  PMISSVALUE !undefined value
00040 REAL,DIMENSION(:),INTENT(OUT) :: PVALU1D !value array
00041 !
00042 integer :: status
00043 character(len=80) :: HACTION
00044 integer,save :: NDIMS=1
00045 integer :: KVARTYPE
00046 integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
00047 character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
00048 integer :: JLOOP
00049 integer :: NGATTS   
00050 character(len=80),DIMENSION(:),ALLOCATABLE :: HNAME
00051 REAL,DIMENSION(:),ALLOCATABLE :: ZVALU1D !value array
00052 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00053 !
00054 include 'netcdf.inc'
00055 !
00056 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:GET1DCDF',0,ZHOOK_HANDLE)
00057 PMISSVALUE=-9999.9
00058 ALLOCATE(NVARDIMID (NDIMS))
00059 ALLOCATE(NVARDIMLEN(NDIMS))
00060 ALLOCATE(NVARDIMNAM(NDIMS))
00061 NVARDIMID (:)=0
00062 NVARDIMLEN(:)=0
00063 NVARDIMNAM(:)=' '
00064 !
00065 HACTION='get variable type'
00066 status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
00067 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00068 !write(0,*) 'variable type = ',KVARTYPE
00069 !
00070 HACTION='get variable dimensions identifiant'
00071 status=nf_inq_vardimid(KCDF_ID,IDVAR,NVARDIMID(NDIMS))
00072 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00073 !write(0,*) 'variable dimension ',NDIMS,' identifiant ',NVARDIMID(NDIMS)
00074 !
00075 HACTION='get variable dimensions name'
00076 status=nf_inq_dimname(KCDF_ID,NVARDIMID(NDIMS),NVARDIMNAM(NDIMS))
00077 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00078 !
00079 HACTION='get variable dimensions length'
00080 status=nf_inq_dimlen(KCDF_ID,NVARDIMID(NDIMS),NVARDIMLEN(NDIMS))
00081 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00082 !write(0,*) 'variable dimension ',NDIMS,' named ',NVARDIMNAM(NDIMS),&
00083 !     &'has a length of',NVARDIMLEN(NDIMS)
00084 !
00085 HACTION='get attributs'
00086 status=nf_inq_natts(KCDF_ID,NGATTS)
00087 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00088 !write(0,*) 'number of attributes = ',NGATTS
00089 allocate(hname(1:NGATTS))
00090 !
00091 DO JLOOP=1,NGATTS
00092   status=nf_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
00093   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00094   !write(0,*) 'attributes names = ', hname(JLOOP)
00095   if (TRIM(hname(JLOOP))=='missing_value') then
00096     !write(0,*) 'missing value search '
00097     HACTION='get missing value'
00098     status=nf_get_att_double(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
00099     if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00100     !write(0,*) 'missing value = ',PMISSVALUE
00101   endif
00102 ENDDO
00103 !
00104 ALLOCATE(ZVALU1D(1:NVARDIMLEN(NDIMS)))
00105 ZVALU1D=0.
00106 !
00107 IF (KVARTYPE>=5) then
00108   HACTION='get variable values (1D)'
00109   status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU1D(:))
00110   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00111 ENDIF
00112 PVALU1D(:)=ZVALU1D(:)
00113 IF (ALLOCATED(ZVALU1D  ))  DEALLOCATE(ZVALU1D)
00114 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:GET1DCDF',1,ZHOOK_HANDLE)
00115 !
00116 END SUBROUTINE GET1DCDF
00117 !-------------------------------------------------------------------
00118 !-------------------------------------------------------------------
00119 !     ####################
00120       SUBROUTINE GET2DCDF(KCDF_ID,IDVAR,PDIM1,HDIM1NAME,PDIM2,HDIM2NAME,&
00121              PMISSVALUE,PVALU2D)  
00122 !     ####################
00123 !
00124 IMPLICIT NONE
00125 !
00126 INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
00127 INTEGER,INTENT(IN) :: IDVAR   !variable to read identifiant
00128 REAL,DIMENSION(:),INTENT(OUT) :: PDIM1,PDIM2 !dimensions for PVALU2D array
00129  CHARACTER(len=80),INTENT(OUT) :: HDIM1NAME,HDIM2NAME     !dimensions names
00130 REAL, INTENT(OUT) :: PMISSVALUE
00131 REAL,DIMENSION(:,:),INTENT(OUT) :: PVALU2D !value array
00132 !
00133 integer :: status
00134 character(len=80) :: HACTION
00135 integer,save :: NDIMS=2
00136 integer :: KVARTYPE
00137 integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
00138 character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
00139 integer :: JLOOP2, JLOOP
00140 integer :: NGATTS   
00141 character(len=80),DIMENSION(:),ALLOCATABLE :: HNAME
00142 real :: ZMISS1,ZMISS2
00143 REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALU2D !value array
00144 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00145 !
00146 include 'netcdf.inc'
00147 !
00148 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:GET2DCDF',0,ZHOOK_HANDLE)
00149 PMISSVALUE=-9999.9 
00150 ALLOCATE(NVARDIMID (NDIMS))
00151 ALLOCATE(NVARDIMLEN(NDIMS))
00152 ALLOCATE(NVARDIMNAM(NDIMS))
00153 NVARDIMID (:)=0
00154 NVARDIMLEN(:)=0
00155 NVARDIMNAM(:)=' '
00156 !
00157 HACTION='get variable type'
00158 status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
00159 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00160 !write(0,*) 'variable type = ',KVARTYPE
00161 !
00162 HACTION='get variable dimensions identifiant'
00163 status=nf_inq_vardimid(KCDF_ID,IDVAR,NVARDIMID)
00164 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00165 !
00166 HACTION='get attributs'
00167 status=nf_inq_natts(KCDF_ID,NGATTS)
00168 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00169 !write(0,*) 'number of attributes = ',NGATTS
00170 allocate(hname(1:NGATTS))
00171 !
00172 DO JLOOP=1,NGATTS
00173   status=nf_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
00174   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00175   !write(0,*) 'attributes names = ', hname(JLOOP)
00176   if (TRIM(hname(JLOOP))=='missing_value') then
00177     !write(0,*) 'missing value search '
00178     HACTION='get missing value'
00179     status=nf_get_att_double(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
00180     if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00181     !write(0,*) 'missing value = ',PMISSVALUE
00182   endif
00183 ENDDO
00184 !
00185 !
00186 DO JLOOP2=1,NDIMS
00187   HACTION='get variable dimensions name'
00188   status=nf_inq_dimname(KCDF_ID,JLOOP2,NVARDIMNAM(JLOOP2))
00189   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00190   HACTION='get variable dimensions length'
00191   status=nf_inq_dimlen(KCDF_ID,JLOOP2,NVARDIMLEN(JLOOP2))
00192   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00193   !write(0,*) 'variable dimension ',JLOOP2,' named ',NVARDIMNAM(JLOOP2),&
00194   !     &'has a length of',NVARDIMLEN(JLOOP2)
00195 ENDDO
00196 ! 
00197 ALLOCATE(ZVALU2D(1:NVARDIMLEN(1),1:NVARDIMLEN(2)))
00198 ZVALU2D=0.
00199 IF (KVARTYPE>=5) then
00200   HACTION='get variable values (2D)'
00201   status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU2D(:,:))
00202   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00203 ENDIF
00204 PVALU2D(:,:)=ZVALU2D(:,:)
00205 !
00206  CALL GET1DCDF(KCDF_ID,NVARDIMID(1),ZMISS1,PDIM1)
00207  CALL GET1DCDF(KCDF_ID,NVARDIMID(2),ZMISS2,PDIM2)
00208 HDIM1NAME=NVARDIMNAM(1)
00209 HDIM2NAME=NVARDIMNAM(2)
00210 IF (ALLOCATED(ZVALU2D  ))  DEALLOCATE(ZVALU2D)
00211 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:GET2DCDF',1,ZHOOK_HANDLE)
00212 !
00213 END SUBROUTINE GET2DCDF
00214 !--------------------------------------------------------------------
00215 !-------------------------------------------------------------------
00216 !     ####################
00217        SUBROUTINE READ_LATLONVAL_CDF(HFILENAME,HNCVARNAME,PLON,PLAT,PVAL)
00218 !     ####################
00219 !
00220 IMPLICIT NONE
00221 !
00222  CHARACTER(LEN=28), INTENT(IN) :: HFILENAME   ! Name of the field file.
00223  CHARACTER(LEN=28), INTENT(IN) :: HNCVARNAME  ! Name of variable to read in netcdf file
00224 REAL, DIMENSION(:), INTENT(OUT) :: PLON,PLAT ! Longitudes/latitudes innetcdf file 
00225 REAL, DIMENSION(:), INTENT(OUT) :: PVAL      ! value to get
00226 !
00227 integer :: status
00228 integer :: kcdf_id
00229 integer :: NBVARS
00230 character(len=80) :: HACTION
00231 character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
00232 integer ::JLOOP1,JDIM1,JDIM2,JLOOP
00233 integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
00234 integer ::NVARDIMS
00235 integer ::NLEN
00236 integer,DIMENSION(1:2) :: NLEN2D
00237 integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
00238 character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
00239 real,DIMENSION(:),ALLOCATABLE   :: ZVALU
00240 real,DIMENSION(:,:),ALLOCATABLE :: ZVALU2D
00241 real :: ZMISS
00242 real,DIMENSION(:),ALLOCATABLE :: ZDIM1
00243 real,DIMENSION(:),ALLOCATABLE :: ZDIM2
00244 character(len=80) :: YDIM1NAME,YDIM2NAME
00245 integer :: ILONFOUND,ILATFOUND, IARG
00246 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00247 !
00248 include 'netcdf.inc'
00249 !
00250 !*    1.      Open the netcdf file 
00251 !             --------------------
00252 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:READ_LATLONVAL_CDF',0,ZHOOK_HANDLE)
00253 status=-9999
00254 kcdf_id=-9999
00255 HACTION='open netcdf'
00256 status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
00257 !write(0,*) 'status=',status
00258 !write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
00259 if (status/=NF_NOERR) then 
00260   CALL HANDLE_ERR_CDF(status,HACTION)
00261 !else
00262 !  write(0,*) 'netcdf file opened: ',HFILENAME
00263 endif
00264 !
00265 !-----------
00266 !
00267 !*    2.      get the number of variables in netcdf file 
00268 !             ------------------------------------------
00269 HACTION='get number of variables'
00270 status=NF_INQ_NVARS(kcdf_id,NBVARS)
00271 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00272 !write(0,*) 'nb vars', NBVARS
00273 ALLOCATE(VARNAME(NBVARS))
00274 !
00275 !-----------
00276 !
00277 !*    3.      get the variables names in netcdf file 
00278 !             --------------------------------------
00279 ID_VARTOGET1=0
00280 ID_VARTOGET2=0
00281 DO JLOOP1=1,NBVARS
00282   HACTION='get variables  names'
00283   status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
00284   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00285   !write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
00286   if (VARNAME(JLOOP1)==HNCVARNAME) then
00287     !write(0,*) 'var',JLOOP1,' corresponding to variable required'
00288     ID_VARTOGET1=JLOOP1
00289   endif
00290   if (VARNAME(JLOOP1)/=HNCVARNAME) then
00291     if((LGT(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
00292            (SCAN(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then  
00293       !write(0,*) 'var',JLOOP1,VARNAME(JLOOP1),' could correspond to variable required ?'
00294       !write(0,*) HNCVARNAME,' is variable required; only ',VARNAME(JLOOP1),' found'
00295       ID_VARTOGET2=JLOOP1
00296     endif
00297   endif
00298 ENDDO
00299 if (ID_VARTOGET1/=0) then
00300   ID_VARTOGET=ID_VARTOGET1
00301 else
00302   ID_VARTOGET=ID_VARTOGET2
00303 endif
00304 if (ID_VARTOGET==0) then
00305   HACTION='close netcdf'
00306   status=nf_close(kcdf_id)
00307   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00308   CALL ABOR1_SFX('MODE_READ_NETCDF: READ_LATLONVAL_CDF')
00309 endif
00310 !-----------
00311 !
00312 !*    4.      get the variable in netcdf file 
00313 !             -------------------------------
00314 !
00315 !     4.1      get the variable dimensions number
00316 !             -----------------------------------
00317 !
00318 HACTION='get variable dimensions number'
00319 status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
00320 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00321 !
00322 !     4.2      get the variable dimensions length and values
00323 !              ----------------------------------------------
00324 SELECT CASE (NVARDIMS)
00325 !CAS 1D
00326   CASE (1) 
00327     !write(0,*) 'variable dimensions number = ',NVARDIMS
00328     HACTION='get variable dimensions length'
00329     status=nf_inq_dimlen(kcdf_id,NVARDIMS,NLEN)
00330     if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00331     ALLOCATE(ZVALU(NLEN))
00332     !write(0,*) 'call GET1DCDF'
00333     CALL GET1DCDF(kcdf_id,ID_VARTOGET,ZMISS,ZVALU)
00334     PVAL(:)=ZVALU(:)
00335 !CAS 2D
00336   CASE (2)
00337     !write(0,*) 'variable dimensions number = ',NVARDIMS
00338     DO JLOOP=1,NVARDIMS
00339       HACTION='get variable dimensions length'
00340       status=nf_inq_dimlen(kcdf_id,JLOOP,NLEN2D(JLOOP))
00341       if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00342     ENDDO
00343     ALLOCATE(ZVALU2D(NLEN2D(1),NLEN2D(2)))
00344     ALLOCATE(ZDIM1(NLEN2D(1)))
00345     ALLOCATE(ZDIM2(NLEN2D(2)))
00346     !write(0,*) 'call GET2DCDF'
00347     CALL GET2DCDF(kcdf_id,ID_VARTOGET,ZDIM1,YDIM1NAME,ZDIM2,YDIM2NAME,&
00348            ZMISS,ZVALU2D)  
00349     !write(0,*) 'YDIM1NAME: ',YDIM1NAME
00350     !write(0,*) 'YDIM2NAME: ',YDIM2NAME
00351     if ((YDIM1NAME=='lon').OR.(YDIM1NAME=='longitude')) ILONFOUND=1
00352     if ((YDIM2NAME=='lon').OR.(YDIM2NAME=='longitude')) ILONFOUND=2
00353     if ((YDIM1NAME=='lat').OR.(YDIM1NAME=='latitude'))  ILATFOUND=1
00354     if ((YDIM2NAME=='lat').OR.(YDIM2NAME=='latitude'))  ILATFOUND=2
00355     IARG=0
00356 !
00357 !     4.3      complete arrays
00358 !              ---------------
00359     IF ((ILONFOUND==1).AND.(ILATFOUND==2)) then
00360       !write(0,*) 'ILONFOUND',ILONFOUND,'ILATFOUND',ILATFOUND
00361       DO JDIM1=1,SIZE(ZDIM1)
00362         DO JDIM2=1,SIZE(ZDIM2)
00363           IARG=IARG+1
00364           PVAL(IARG)=ZVALU2D(JDIM1,JDIM2)
00365           PLON(IARG)=ZDIM1(JDIM1)
00366           PLAT(IARG)=ZDIM2(JDIM2)
00367         ENDDO
00368       ENDDO
00369     ELSEIF ((ILONFOUND==2).AND.(ILATFOUND==1)) then
00370       !write(0,*) 'ILONFOUND',ILONFOUND,'ILATFOUND',ILATFOUND
00371       DO JDIM1=1,SIZE(ZDIM1)
00372         DO JDIM2=1,SIZE(ZDIM2)
00373           IARG=IARG+1
00374           PVAL(IARG)=ZVALU2D(JDIM1,JDIM2)
00375           PLAT(IARG)=ZDIM1(JDIM1)
00376           PLON(IARG)=ZDIM2(JDIM2)
00377         ENDDO
00378       ENDDO
00379     ELSE
00380       write(0,*) '*****WARNING*****: incompatible dimensions to lat/lon/value arrays'
00381     ENDIF
00382 !
00383 END SELECT
00384 !
00385 !
00386 !-----------
00387 !*    10.     Close the netcdf file 
00388 !             ---------------------
00389 HACTION='close netcdf'
00390 status=nf_close(kcdf_id)
00391 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00392 !write(0,*) 'OK: netcdf file closed: ',HFILENAME
00393 !
00394 !-----------
00395 !*    11.     Deallocate 
00396 !             ----------
00397 IF (ALLOCATED(VARNAME     ))  DEALLOCATE(VARNAME)
00398 IF (ALLOCATED(ZVALU       ))  DEALLOCATE(ZVALU  )
00399 IF (ALLOCATED(ZVALU2D     ))  DEALLOCATE(ZVALU2D)
00400 IF (ALLOCATED(ZDIM1       ))  DEALLOCATE(ZDIM1  )
00401 IF (ALLOCATED(ZDIM2       ))  DEALLOCATE(ZDIM2  )
00402 !
00403 IF (ALLOCATED(NVARDIMID   ))  DEALLOCATE(NVARDIMID )
00404 IF (ALLOCATED(NVARDIMNAM  ))  DEALLOCATE(NVARDIMNAM)
00405 IF (ALLOCATED(NVARDIMLEN  ))  DEALLOCATE(NVARDIMLEN)
00406 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:READ_LATLONVAL_CDF',1,ZHOOK_HANDLE)
00407 END SUBROUTINE READ_LATLONVAL_CDF
00408 !------------------------------------------------------------------------------
00409 !==============================================================================
00410 !     ####################
00411        SUBROUTINE READ_DIM_CDF(HFILENAME,HNCVARNAME,KDIM)
00412 !     ####################
00413 !
00414 IMPLICIT NONE
00415 !
00416  CHARACTER(LEN=28), INTENT(IN) :: HFILENAME   ! Name of the field file.
00417  CHARACTER(LEN=28), INTENT(IN) :: HNCVARNAME  ! Name of variable to read in netcdf file
00418 INTEGER,           INTENT(OUT):: KDIM        ! value of dimension to get
00419 !
00420 integer :: status
00421 integer :: kcdf_id
00422 integer :: NBVARS
00423 character(len=80) :: HACTION
00424 character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
00425 integer ::JLOOP1,JLOOP
00426 integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
00427 integer ::NVARDIMS
00428 integer,DIMENSION(2) ::NLEN2D
00429 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00430 !
00431 include 'netcdf.inc'
00432 !
00433 !*    1.      Open the netcdf file 
00434 !             --------------------
00435 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:READ_DIM_CDF',0,ZHOOK_HANDLE)
00436 HACTION='open netcdf'
00437 status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
00438 !write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
00439 if (status/=NF_NOERR) then 
00440   CALL HANDLE_ERR_CDF(status,HACTION)
00441 !else
00442 !  write(0,*) 'netcdf file opened: ',HFILENAME
00443 endif
00444 !
00445 !-----------
00446 !
00447 !*    2.      get the number of variables in netcdf file 
00448 !             ------------------------------------------
00449 HACTION='get number of variables'
00450 status=NF_INQ_NVARS(kcdf_id,NBVARS)
00451 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00452 !write(0,*) 'nb vars', NBVARS
00453 ALLOCATE(VARNAME(NBVARS))
00454 !
00455 !-----------
00456 !
00457 !*    3.      get the variables names in netcdf file 
00458 !             --------------------------------------
00459 ID_VARTOGET1=0
00460 ID_VARTOGET2=0
00461 DO JLOOP1=1,NBVARS
00462   HACTION='get variables  names'
00463   status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
00464   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00465   !write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
00466   if (VARNAME(JLOOP1)==HNCVARNAME) then
00467     !write(0,*) 'var',JLOOP1,' corresponding to variable required'
00468     ID_VARTOGET1=JLOOP1
00469   endif
00470   if (VARNAME(JLOOP1)/=HNCVARNAME) then
00471     if((LGT(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
00472            (SCAN(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then  
00473       !write(0,*) 'var',JLOOP1,VARNAME(JLOOP1),' could correspond to variable required ?'
00474       !write(0,*) HNCVARNAME,' is variable required; only ',VARNAME(JLOOP1),' found'
00475       ID_VARTOGET2=JLOOP1
00476     endif
00477   endif
00478 ENDDO
00479 if (ID_VARTOGET1/=0) then
00480   ID_VARTOGET=ID_VARTOGET1
00481 else
00482   ID_VARTOGET=ID_VARTOGET2
00483 endif
00484 if (ID_VARTOGET==0) then
00485   HACTION='close netcdf'
00486   status=nf_close(kcdf_id)
00487   if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00488   CALL ABOR1_SFX('MODE_READ_CDF: READ_DIM_CDF')
00489 endif
00490 !-----------
00491 !
00492 !*    4.      get the total dimension of HNCVARNAME 
00493 !             -------------------------------------
00494 !
00495 !     4.1      get the variable dimensions number
00496 !             -----------------------------------
00497 !
00498 HACTION='get variable dimensions number'
00499 status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
00500 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00501 !write(0,*) 'variable dimensions number = ',NVARDIMS
00502 !
00503 !     4.2      get the variable dimensions length
00504 !              ----------------------------------
00505 SELECT CASE (NVARDIMS)
00506 !CAS 1D
00507   CASE (1) 
00508     HACTION='get variable dimensions length'
00509     status=nf_inq_dimlen(kcdf_id,NVARDIMS,KDIM)
00510     if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00511 !
00512 !CAS 2D
00513   CASE (2)
00514     KDIM=1
00515     DO JLOOP=1,NVARDIMS
00516       HACTION='get variable dimensions length'
00517       status=nf_inq_dimlen(kcdf_id,JLOOP,NLEN2D(JLOOP))
00518       if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00519       KDIM=KDIM*NLEN2D(JLOOP)
00520     ENDDO
00521 END SELECT
00522 !-----------
00523 !*    10.     Close the netcdf file 
00524 !             ---------------------
00525 HACTION='close netcdf'
00526 status=nf_close(kcdf_id)
00527 if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
00528 !write(0,*) 'OK: netcdf file closed: ',HFILENAME
00529 !
00530 !-----------
00531 !*    11.     Deallocate 
00532 !             ----------
00533 IF (ALLOCATED(VARNAME     ))  DEALLOCATE(VARNAME)
00534 IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:READ_DIM_CDF',1,ZHOOK_HANDLE)
00535 !
00536 END SUBROUTINE READ_DIM_CDF
00537 !------------------------------------------------------------------------------
00538 !==============================================================================
00539 END MODULE MODE_READ_CDF