source: CPL/oasis3-mct/branches/OASIS3-MCT_5.0_branch/examples/spoc/spoc_regridding/write_all_fields.F90 @ 6331

Last change on this file since 6331 was 6331, checked in by aclsce, 17 months ago

Moved oasis-mct_5.0 in oasis3-mct/branches directory.
File size: 5.8 KB
Line 
1MODULE write_all_fields 
2  !
3  USE netcdf
4  IMPLICIT NONE
5  !
6  !
7  CONTAINS
8    !
9 !****************************************************************************************
10  SUBROUTINE write_field (nlon,nlat, &
11                          data_filename, field_name, w_unit, file_debug, &
12                          gridlon, gridlat, array)
13  !**************************************************************************************
14  !
15  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
16  !
17  INTEGER                  :: i,j,k,w_unit
18  LOGICAL                  :: file_debug
19  INTEGER                  :: il_file_id, il_array_id, il_lon_id, il_lat_id 
20  INTEGER                  :: LONID, LATID
21  !               
22  INTEGER, INTENT(in)     :: nlon,nlat
23  !
24  CHARACTER(len=30)        :: data_filename,field_name
25  !
26  INTEGER,  DIMENSION(2)   :: ila_dim
27  INTEGER,  DIMENSION(2)   :: ila_what
28  !
29  REAL (kind=wp), DIMENSION(nlon,nlat)  :: gridlon,gridlat
30  REAL (kind=wp), DIMENSION(nlon,nlat)  :: array
31  !
32  REAL (kind=wp) :: dl_missing_value, dl_FillValue
33  !
34  ! Dimensions
35  !
36  CALL hdlerr(NF90_CREATE(data_filename, NF90_CLOBBER, il_file_id), __LINE__ )
37  !
38  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon", nlon, LONID), __LINE__ )
39  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat", nlat, LATID), __LINE__ )
40  !
41  CALL hdlerr( NF90_DEF_VAR(il_file_id, "lon", NF90_DOUBLE, (/LONID, LATID/), il_lon_id), __LINE__ )
42  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lon_id, "units", "degrees_east"), __LINE__ )
43  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lon_id, "standard_name", "longitude"), __LINE__ )
44  CALL hdlerr( NF90_DEF_VAR(il_file_id, "lat", NF90_DOUBLE, (/LONID, LATID/), il_lat_id), __LINE__ )
45  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lat_id, "units", "degrees_north"), __LINE__ )
46  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lat_id, "standard_name", "latitude"), __LINE__ )
47  !
48  CALL hdlerr( NF90_DEF_VAR(il_file_id, TRIM(field_name), NF90_DOUBLE, (/LONID, LATID/), il_array_id), __LINE__ )
49  SELECT CASE (field_name)
50  CASE ("FRECVANA")
51      dl_missing_value = 10000.d0
52      dl_FillValue = 1.d+20
53  CASE ("error_interp")
54      CALL hdlerr( NF90_PUT_ATT(il_file_id, il_array_id, "units", "%"), __LINE__ )
55      dl_missing_value = -10000.d0
56      dl_FillValue = -1.d+20
57  CASE DEFAULT
58      dl_missing_value = -1.d+34 ! Ferret default missing value
59      dl_FillValue = -1.d+34
60  END SELECT
61  !gjoffCALL hdlerr( NF90_PUT_ATT(il_file_id, il_array_id, "missing_value", dl_missing_value),__LINE__ )
62  !gjoffCALL hdlerr( NF90_PUT_ATT(il_file_id, il_array_id, "_FillValue", dl_FillValue),__LINE__ )
63  !
64  CALL hdlerr( NF90_ENDDEF(il_file_id), __LINE__ )
65  !
66  ila_what(:)=1
67  !
68  ila_dim(1)=nlon
69  ila_dim(2)=nlat
70  !
71  ! Data
72  !
73  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lon_id, gridlon, &
74     ila_what, ila_dim), __LINE__ )
75  !
76  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lat_id, gridlat, &
77     ila_what, ila_dim), __LINE__ )
78  !
79  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_array_id, array, &
80     ila_what, ila_dim), __LINE__ )
81  IF (file_debug) THEN
82      WRITE(w_unit,*) 'Local fields writing done'
83      CALL FLUSH(w_unit)
84  ENDIF
85  !
86  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
87  !
88  IF (file_debug) THEN
89      WRITE(w_unit,*) 'End of routine write field'
90      CALL FLUSH(w_unit)
91  ENDIF
92  !
93END SUBROUTINE write_field
94
95 !****************************************************************************************
96  SUBROUTINE write_field_i2 (nlon,nlat, &
97                          data_filename, field_name, w_unit, file_debug, &
98                          gridlon, gridlat, array)
99  !**************************************************************************************
100  !
101  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
102  !
103  INTEGER                  :: i,j,k,w_unit
104  LOGICAL                  :: file_debug
105  INTEGER                  :: il_file_id, il_array_id, il_lon_id, il_lat_id
106  INTEGER                  :: LONID, LATID
107  !               
108  INTEGER, INTENT(in)     :: nlon,nlat
109  !
110  CHARACTER(len=30)        :: data_filename,field_name
111  !
112  INTEGER,  DIMENSION(2)   :: ila_dim
113  INTEGER,  DIMENSION(2)   :: ila_what
114  !
115  REAL (kind=wp), DIMENSION(nlon,nlat)  :: gridlon,gridlat
116  INTEGER, DIMENSION(nlon,nlat)  :: array
117  !
118  ! Dimensions
119  !
120  CALL hdlerr(NF90_CREATE(data_filename, NF90_CLOBBER, il_file_id), __LINE__ )
121  !
122  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon", nlon, LONID), __LINE__ )
123  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat", nlat, LATID), __LINE__ )
124  !
125  CALL hdlerr( NF90_DEF_VAR(il_file_id, "lon", NF90_DOUBLE, (/LONID, LATID/),il_lon_id), __LINE__ )
126  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lon_id, "units", "degrees_east"),__LINE__ )
127  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lon_id, "standard_name","longitude"), __LINE__ )
128  CALL hdlerr( NF90_DEF_VAR(il_file_id, "lat", NF90_DOUBLE, (/LONID, LATID/),il_lat_id), __LINE__ )
129  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lat_id, "units", "degrees_north"),__LINE__ )
130  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lat_id, "standard_name", "latitude"),__LINE__ )
131  !
132  CALL hdlerr( NF90_DEF_VAR(il_file_id, TRIM(field_name), NF90_INT, (/LONID,LATID/), il_array_id), __LINE__ )
133  !
134  CALL hdlerr( NF90_ENDDEF(il_file_id), __LINE__ )
135  !
136  ila_what(:)=1
137  !
138  ila_dim(1)=nlon
139  ila_dim(2)=nlat
140  !
141  ! Data
142  !
143  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lon_id, gridlon, &
144     ila_what, ila_dim), __LINE__ )
145  !
146  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lat_id, gridlat, &
147     ila_what, ila_dim), __LINE__ )
148  !
149  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_array_id, array, &
150     ila_what, ila_dim), __LINE__ )
151  IF (file_debug) THEN
152      WRITE(w_unit,*) 'Local fields writing done'
153      CALL FLUSH(w_unit)
154  ENDIF
155  !
156  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
157  !
158  IF (file_debug) THEN
159      WRITE(w_unit,*) 'End of routine write field'
160      CALL FLUSH(w_unit)
161  ENDIF
162  !
163END SUBROUTINE write_field_i2
164END MODULE write_all_fields
Note: See TracBrowser for help on using the repository browser.