source: CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/write_grids_masks.F90 @ 4775

Last change on this file since 4775 was 4775, checked in by aclsce, 5 years ago
  • Imported oasis3-mct from Cerfacs svn server (not suppotred anymore).

The version has been extracted from ​https://oasis3mct.cerfacs.fr/svn/branches/OASIS3-MCT_2.0_branch/oasis3-mct@1818
File size: 6.8 KB
Line 
1  !****************************************************************************************
2  SUBROUTINE write_grids_masks (nlon1,nlat1,nlon2,nlat2,corners_ij, &
3                               grids_name, gridt_name, w_unit, &
4                               gridlon1,gridlat1, gridclo1,gridcla1, indice_mask1, &
5                               gridlon2,gridlat2, gridclo2,gridcla2, indice_mask2)
6  !**************************************************************************************
7  !
8  USE netcdf
9  IMPLICIT NONE
10  !
11  INTEGER                  :: i,j,k,w_unit
12  !
13  INTEGER                  :: LONID1, LATID1, LONID2, LATID2, CC1, CC2
14  INTEGER                  :: il_file_id,il_lon_id1, &
15                              il_lat_id1,il_clo_id1,il_cla_id1,il_indice_id1, &
16                              il_lon_id2,il_lat_id2,il_clo_id2,il_cla_id2,il_indice_id2
17  !               
18  INTEGER, INTENT(in)     :: nlon1,nlat1,nlon2,nlat2,corners_ij
19  !
20  CHARACTER(len=4)         :: grids_name,gridt_name
21  CHARACTER(len=8)         :: cl1_nam_lon, cl1_nam_lat, cl1_nam_msk, cl1_nam_clo, cl1_nam_cla
22  CHARACTER(len=8)         :: cl2_nam_lon, cl2_nam_lat, cl2_nam_msk, cl2_nam_clo, cl2_nam_cla
23  !
24  INTEGER,  DIMENSION(3)   :: ila_dim
25  INTEGER,  DIMENSION(3)   :: ila_corners,ila_what
26  !
27  DOUBLE PRECISION, DIMENSION(nlon1,nlat1)                :: gridlon1,gridlat1
28  DOUBLE PRECISION, DIMENSION(nlon1,nlat1,corners_ij) :: gridclo1,gridcla1
29  INTEGER,          DIMENSION(nlon1,nlat1)                :: indice_mask1
30  DOUBLE PRECISION, DIMENSION(nlon2,nlat2)                :: gridlon2,gridlat2
31  DOUBLE PRECISION, DIMENSION(nlon2,nlat2,corners_ij) :: gridclo2,gridcla2
32  INTEGER,          DIMENSION(nlon2,nlat2)                :: indice_mask2
33  !
34  !
35  ! Dimensions
36  !
37  cl1_nam_lon=grids_name//".lon"
38  cl1_nam_clo=grids_name//".clo"
39  cl1_nam_lat=grids_name//".lat"
40  cl1_nam_cla=grids_name//".cla"
41  cl1_nam_msk=grids_name//".msk"
42  !
43  cl2_nam_lon=gridt_name//".lon"
44  cl2_nam_clo=gridt_name//".clo"
45  cl2_nam_lat=gridt_name//".lat"
46  cl2_nam_cla=gridt_name//".cla"
47  cl2_nam_msk=gridt_name//".msk"
48  !
49  !
50  CALL hdlerr(NF90_CREATE('grids.nc', NF90_CLOBBER, il_file_id), __LINE__ )
51  !
52  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon1", nlon1, LONID1), __LINE__ )
53  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat1", nlat1, LATID1), __LINE__ )
54  CALL hdlerr( NF90_DEF_DIM(il_file_id, "crn1", corners_ij, CC1), __LINE__ )
55  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon2", nlon2, LONID2), __LINE__ )
56  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat2", nlat2, LATID2), __LINE__ )
57  CALL hdlerr( NF90_DEF_DIM(il_file_id, "crn2", corners_ij, CC2), __LINE__ )
58  !
59  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_lon, NF90_REAL, (/LONID1, LATID1/), il_lon_id1), __LINE__ )
60  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_lat, NF90_REAL, (/LONID1, LATID1/), il_lat_id1), __LINE__ )
61  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_clo, NF90_REAL, (/LONID1, LATID1, CC1/), il_clo_id1), __LINE__ )
62  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_cla, NF90_REAL, (/LONID1, LATID1, CC1/), il_cla_id1), __LINE__ )
63  !
64  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_lon, NF90_REAL, (/LONID2, LATID2/), il_lon_id2), __LINE__ )
65  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_lat, NF90_REAL, (/LONID2, LATID2/), il_lat_id2), __LINE__ )
66  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_clo, NF90_REAL, (/LONID2, LATID2, CC2/), il_clo_id2), __LINE__ )
67  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_cla, NF90_REAL, (/LONID2, LATID2, CC2/), il_cla_id2), __LINE__ )
68  !
69  CALL hdlerr( NF90_ENDDEF(il_file_id), __LINE__ )
70  !
71  ila_what(:)=1
72  !
73  ila_dim(1)=nlon1
74  ila_dim(2)=nlat1
75  ila_dim(3)=1
76  !
77  ila_corners(1)=nlon1
78  ila_corners(2)=nlat1
79  ila_corners(3)=corners_ij
80  !
81  ! Write Data in grids.nc
82  !
83  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lon_id1, gridlon1, &
84     ila_what(1:2), ila_dim(1:2)), __LINE__ )
85  WRITE(w_unit,*) 'Global source grid longitudes writing done'
86  CALL FLUSH(w_unit)
87  !
88  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lat_id1, gridlat1, &
89     ila_what(1:2), ila_dim(1:2)), __LINE__ )
90  WRITE(w_unit,*) 'Global source grid latitudes writing done'
91  CALL FLUSH(w_unit)
92  !
93  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_clo_id1, gridclo1, &
94     ila_what, ila_corners), __LINE__ )
95  WRITE(w_unit,*) 'Global source grid clo writing done'
96  CALL FLUSH(w_unit)
97  !
98  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_cla_id1, gridcla1, &
99     ila_what, ila_corners), __LINE__ )
100  WRITE(w_unit,*) 'Global source grid cla writing done'
101  CALL FLUSH(w_unit)
102  !
103  ila_what(:)=1
104  !
105  ila_dim(1)=nlon2
106  ila_dim(2)=nlat2
107  ila_dim(3)=1
108  !
109  ila_corners(1)=nlon2
110  ila_corners(2)=nlat2
111  ila_corners(3)=corners_ij
112  !
113  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lon_id2, gridlon2, &
114     ila_what(1:2), ila_dim(1:2)), __LINE__ )
115  WRITE(w_unit,*) 'Global target grid longitudes writing done'
116  CALL FLUSH(w_unit)
117  !
118  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lat_id2, gridlat2, &
119     ila_what(1:2), ila_dim(1:2)), __LINE__ )
120  WRITE(w_unit,*) 'Global target grid latitudes writing done'
121  CALL FLUSH(w_unit)
122  !
123  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_clo_id2, gridclo2, &
124     ila_what, ila_corners), __LINE__ )
125  WRITE(w_unit,*) 'Global target grid clo writing done'
126  CALL FLUSH(w_unit)
127  !
128  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_cla_id2, gridcla2, &
129     ila_what, ila_corners), __LINE__ )
130  WRITE(w_unit,*) 'Global target grid cla writing done'
131  CALL FLUSH(w_unit)
132  !
133  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
134  !
135  !
136  CALL hdlerr(NF90_CREATE('masks.nc', NF90_CLOBBER, il_file_id), __LINE__ )
137  !
138  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon1", nlon1, LONID1), __LINE__ )
139  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat1", nlat1, LATID1), __LINE__ )
140  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon2", nlon2, LONID2), __LINE__ )
141  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat2", nlat2, LATID2), __LINE__ )
142  !
143  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_msk, NF90_INT, (/LONID1, LATID1/), il_indice_id1), __LINE__ )
144  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_msk, NF90_INT, (/LONID2, LATID2/), il_indice_id2), __LINE__ )
145  !
146  CALL hdlerr( NF90_ENDDEF(il_file_id), __LINE__ )
147  !
148  ila_what(:)=1
149  !
150  ila_dim(1)=nlon1
151  ila_dim(2)=nlat1
152  ila_dim(3)=1
153  !
154  ! Write Data in masks.nc
155  !
156  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_indice_id1, indice_mask1, &
157     ila_what(1:2), ila_dim(1:2)), __LINE__ )
158  WRITE(w_unit,*) 'Global source grid mask writing done'
159  CALL FLUSH(w_unit)
160  !
161  ila_what(:)=1
162  !
163  ila_dim(1)=nlon2
164  ila_dim(2)=nlat2
165  ila_dim(3)=1
166  !
167  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_indice_id2, indice_mask2, &
168     ila_what(1:2), ila_dim(1:2)), __LINE__ )
169  WRITE(w_unit,*) 'Global target grid mask writing done'
170  CALL FLUSH(w_unit)
171  !
172  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
173  !
174  WRITE(w_unit,*) 'End of routine write_grids_masks'
175  CALL FLUSH(w_unit)
176  !
177END SUBROUTINE write_grids_masks
Note: See TracBrowser for help on using the repository browser.