source: trunk/LMDZ.COMMON/libf/evolution/nb_time_step_GCM.F90 @ 2855

Last change on this file since 2855 was 2855, checked in by llange, 2 years ago

PEM
Documentation of the main subroutines, and variables.
Unused programs have been removed.
LL

File size: 3.0 KB
Line 
1!
2! $Id $
3!
4SUBROUTINE nb_time_step_GCM(fichnom,timelen)
5
6      use netcdf, only: nf90_open,NF90_NOWRITE,nf90_noerr,nf90_strerror, &
7                        nf90_get_var, nf90_inq_varid, nf90_inq_dimid, &
8                        nf90_inquire_dimension,nf90_close
9
10      IMPLICIT NONE
11
12!=======================================================================
13!
14! Purpose: Read in the data_GCM_Yr*.nc the number of time step
15!
16! Author: RV
17!=======================================================================
18
19  include "dimensions.h"
20
21!===============================================================================
22! Arguments:
23  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
24!===============================================================================
25!   Local Variables
26  CHARACTER(LEN=256) :: msg, var, modname
27  INTEGER :: iq, fID, vID, idecal
28  INTEGER :: ierr
29
30  INTEGER :: timelen ! number of times stored in the file
31!-----------------------------------------------------------------------
32  modname="nb_time_step_GCM"
33
34!  Open initial state NetCDF file
35  var=fichnom
36  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
37
38      ierr = nf90_inq_varid (fID, "temps", vID)
39      IF (ierr .NE. nf90_noerr) THEN
40        write(*,*)"read_data_GCM: Le champ <temps> est absent"
41        write(*,*)"read_data_GCM: J essaie <time_counter>"
42        ierr = nf90_inq_varid (fID, "time_counter", vID)
43        IF (ierr .NE. nf90_noerr) THEN
44          write(*,*)"read_data_GCM: Le champ <time_counter> est absent"
45          write(*,*)"read_data_GCM: J essaie <Time>"
46          IF (ierr .NE. nf90_noerr) THEN
47            write(*,*)"read_data_GCM: Le champ <Time> est absent"
48            write(*,*)trim(nf90_strerror(ierr))
49            CALL ABORT_gcm("read_data_GCM", "", 1)
50          ENDIF
51          ! Get the length of the "Time" dimension
52          ierr = nf90_inq_dimid(fID,"Time",vID)
53          ierr = nf90_inquire_dimension(fID,vID,len=timelen)         
54        ENDIF
55        ! Get the length of the "time_counter" dimension
56        ierr = nf90_inq_dimid(fID,"time_counter",vID)
57        ierr = nf90_inquire_dimension(fID,vID,len=timelen)
58      ELSE   
59        ! Get the length of the "temps" dimension
60        ierr = nf90_inq_dimid(fID,"temps",vID)
61        ierr = nf90_inquire_dimension(fID,vID,len=timelen)
62      ENDIF
63
64  CALL err(NF90_CLOSE(fID),"close",fichnom)
65
66  print *, "The number of timestep of the PCM run data=", timelen
67
68  CONTAINS
69
70SUBROUTINE err(ierr,typ,nam)
71  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
72  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
73  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
74  IF(ierr==NF90_NoERR) RETURN
75  SELECT CASE(typ)
76    CASE('inq');   msg="Field <"//TRIM(nam)//"> is missing"
77    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
78    CASE('open');  msg="File opening failed for <"//TRIM(nam)//">"
79    CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
80  END SELECT
81  CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
82END SUBROUTINE err
83
84END SUBROUTINE nb_time_step_GCM
Note: See TracBrowser for help on using the repository browser.