source: branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90 @ 2858

Last change on this file since 2858 was 2858, checked in by cbricaud, 9 years ago

cleanning, minor modifications

  • Property svn:executable set to *
File size: 5.9 KB
Line 
1MODULE readcoordmesh
2  !!=====================================================================
3  !!                       ***  MODULE  readcoordmesh  ***
4  !!
5  !! History: 2011: cbricaud Mercator-Ocean
6  !!
7  !!=====================================================================
8  !! * Modules used
9  USE netcdf
10  USE declarations
11
12  IMPLICIT NONE
13  PRIVATE
14 
15  PUBLIC  read_coord_mesh
16
17CONTAINS
18
19  SUBROUTINE read_coord_mesh
20  !!---------------------------------------------------------------------
21  !!              ***  ROUTINE coord_mesh_read  ***
22  !!
23  !! ** Purpose :   Read a coordinate and a meshmask file in NetCDF format
24  !!---------------------------------------------------------------------     
25  PRINT*,'              '
26  PRINT*,'READ COORDINATES AND MESHMASK'
27  PRINT*,'-----------------------------'
28
29  ! Get coordinates dimensions
30  CALL getdim(cdfile="coordinates.nc")
31
32  !Allocate coordinates array with domain size
33  ALLOCATE(glamt(jpi,jpj)) ; ALLOCATE(gphit(jpi,jpj))
34  ALLOCATE(glamf(jpi,jpj)) ; ALLOCATE(gphif(jpi,jpj))
35  ALLOCATE(e1t(jpi,jpj)  )   
36
37  !Read glamt
38  CALL read_ncdf(cdfile="coordinates.nc",cdvar="glamt",ksize=(/jpi,jpj,1,1/),ptab=glamt)
39
40  !Read gphit
41  CALL read_ncdf(cdfile="coordinates.nc",cdvar="gphit",ksize=(/jpi,jpj,1,1/),ptab=gphit)
42
43  !Read glamf
44  CALL read_ncdf(cdfile="coordinates.nc",cdvar="glamf",ksize=(/jpi,jpj,1,1/),ptab=glamf)
45
46  !Read gphif
47  CALL read_ncdf(cdfile="coordinates.nc",cdvar="gphif",ksize=(/jpi,jpj,1,1/),ptab=gphif)
48
49  !Read e1t
50  CALL read_ncdf(cdfile="coordinates.nc",cdvar="e1t",ksize=(/jpi,jpj,1,1/),ptab=e1t)
51
52  END SUBROUTINE read_coord_mesh
53
54  SUBROUTINE getdim(cdfile)
55  !!----------------------------------------------------------------------
56  !!              ***  ROUTINE coord_mesh_read  ***
57  !!
58  !! ** Purpose :   Read a coordinate and a meshmask file in NetCDF format
59  !!----------------------------------------------------------------------
60  !! * Arguments
61  CHARACTER(*),INTENT(IN):: cdfile
62
63  !! * Local declarations
64  INTEGER           :: ncid                 ! file unit
65  INTEGER           :: idims                ! number of dimensions
66  INTEGER           :: istatus, id_var      ! dummy variable
67  CHARACTER(len=30) :: clname               ! dimension name   
68  INTEGER, ALLOCATABLE,DIMENSION(:) :: ndim ! dimensions value
69  !!----------------------------------------------------------------------
70
71  !Open file
72  istatus=NF90_OPEN(TRIM(cdfile),nf90_nowrite,ncid)
73
74  IF( istatus/= NF90_NOERR )THEN
75     PRINT*,TRIM(cdfile),' not found.stop ' ; STOP
76  ELSE
77 
78     ! read number of dimensions   
79     istatus=NF90_INQUIRE(ncid,ndimensions=idims)
80
81     ALLOCATE( ndim(idims) )
82
83     ! read each dimension
84     PRINT*,'     File dimensions: '
85     DO id_var=1,idims
86        istatus=NF90_Inquire_Dimension(ncid,id_var,clname,ndim(id_var))
87        PRINT*,'       ',id_var,clname,ndim(id_var)
88     ENDDO
89
90     !close
91     istatus=NF90_CLOSE( ncid )             
92     IF( istatus/=NF90_NOERR )THEN
93        PRINT*,'Problem for closing ',TRIM(cdfile);STOP
94     ELSE
95        PRINT*,'     close ',TRIM(cdfile),' OK'
96     ENDIF
97
98  ENDIF
99
100  !domain dimensions
101  jpi = ndim(1)
102  jpj = ndim(2)
103
104  DEALLOCATE( ndim )
105  END SUBROUTINE getdim
106
107  SUBROUTINE read_ncdf(cdfile,cdvar,ksize,ptab,kstart,kcount)
108  !!----------------------------------------------------------------------
109  !!              ***  ROUTINE coord_mesh_read  ***
110  !!
111  !! ** Purpose :   Read a coordinate and a meshmask file in NetCDF format
112  !!----------------------------------------------------------------------
113  !! * Arguments
114  CHARACTER(*),        INTENT(IN)                                    :: cdfile
115  CHARACTER(*),        INTENT(IN)                                    :: cdvar
116  INTEGER,DIMENSION(4),INTENT(IN)                                    :: ksize
117  INTEGER,DIMENSION(4),INTENT(IN),OPTIONAL                           :: kstart,kcount
118  REAL(wp),DIMENSION(ksize(1),ksize(2),ksize(3),ksize(4)),INTENT(OUT):: ptab
119
120  !! * Local declarations
121  INTEGER                                 ::istatus,ncid,id_var,len
122  CHARACTER(len=30) :: clname , cdvar2
123
124  INTEGER :: idims
125  INTEGER,DIMENSION(3)::idimids 
126  !!----------------------------------------------------------------------
127  ptab=0.
128  PRINT*,'read ',TRIM(cdvar),' in ',TRIM(cdfile)
129 
130  !OPEN
131  !----
132  istatus=NF90_OPEN(TRIM(cdfile),nf90_nowrite,ncid)
133  IF( istatus/= NF90_NOERR )THEN
134     PRINT*,TRIM(cdfile),' not found.stop ' ; STOP
135  ENDIF
136
137  !READ
138  !----
139  !search variable
140  istatus=NF90_INQ_VARID (ncid,TRIM(cdvar),id_var)
141  IF( istatus/=NF90_NOERR )THEN
142      PRINT*,TRIM(cdvar),' not found in ',TRIM(cdfile),'.stop';STOP
143  ENDIF
144
145  !get variable
146  !------------
147  istatus=nf90_inquire_variable(ncid,id_var, cdvar2, ndims=idims, dimids=idimids)
148  IF ( PRESENT(kstart) .AND. PRESENT(kcount) )THEN 
149      istatus=NF90_GET_VAR(ncid,id_var,ptab,start=kstart,count=kcount)
150  ELSE
151      istatus=NF90_GET_VAR(ncid,id_var,ptab)
152  ENDIF
153
154  CALL ERR_HDL(istatus)
155
156  IF( istatus/=NF90_NOERR )THEN
157           PRINT*,'Problem for reading ',TRIM(cdvar),' in ',TRIM(cdfile); STOP
158  ELSE
159      PRINT*,'     read ',TRIM(cdvar),' OK'
160  ENDIF
161
162  !CLOSE
163  !-----
164  istatus=NF90_CLOSE( ncid )
165  IF( istatus/=NF90_NOERR )THEN
166      PRINT*,'Problem for closing ',TRIM(cdfile);stop
167  ELSE
168      PRINT*,'     close ',TRIM(cdfile),' OK'
169  ENDIF
170
171
172  END SUBROUTINE read_ncdf
173
174  SUBROUTINE ERR_HDL(kstatus)
175  !! ----------------------------------------------------------
176  !!   ***  SUBROUTINE err_hdl
177  !!
178  !!   ** Purpose :  Error handle for NetCDF routine.
179  !!          Stop if kstatus indicates error conditions.
180  !!
181  !! History :
182  !!     Original: J.M. Molines (01/99)
183  !!
184  !! -----------------------------------------------------------
185  INTEGER, INTENT(in) ::  kstatus
186
187  !! -----------------------------------------------------------
188  IF( kstatus /=  NF90_NOERR ) THEN
189     PRINT *, 'ERROR in NETCDF routine, status=',kstatus
190     PRINT *,NF90_STRERROR(kstatus)
191     STOP
192  END IF
193
194  END SUBROUTINE ERR_HDL
195
196END MODULE readcoordmesh
Note: See TracBrowser for help on using the repository browser.