source: LMDZ6/branches/IPSLCM6.0.15/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90 @ 3158

Last change on this file since 3158 was 2600, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn comvert.h into module comvert_mod.F90
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 7.5 KB
Line 
1!
2! $Id: $
3!
4! This subroutine creates the file grilles_gcm.nc containg longitudes and
5! latitudes in degrees for grid u and v. This subroutine is called from
6! ce0l. This subroutine corresponds to the first
7! part in the program create_fausse_var.
8!
9SUBROUTINE grilles_gcm_netcdf_sub(masque,phis)
10
11  USE comconst_mod, ONLY: cpp, kappa, g, omeg, daysec, rad, pi
12  USE comvert_mod, ONLY: presnivs, preff, pa
13 
14  IMPLICIT NONE
15
16  INCLUDE "dimensions.h"
17  INCLUDE "paramet.h"
18  INCLUDE "comgeom.h"
19  INCLUDE "netcdf.inc"
20
21
22  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: masque ! masque terre/mer
23  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: phis   ! geopotentiel au sol
24
25  REAL temp(iim+1,jjm+1)
26  ! Attributs netcdf sortie
27  INTEGER ncid_out,rcode_out
28  INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid,out_levid
29  INTEGER out_varid
30  INTEGER out_lonudim,out_lonvdim
31  INTEGER out_latudim,out_latvdim,out_dim(3)
32  INTEGER out_levdim
33
34  INTEGER start(4),COUNT(4)
35
36  INTEGER status,i,j
37  REAL rlatudeg(jjp1),rlatvdeg(jjm),rlevdeg(llm)
38  REAL rlonudeg(iip1),rlonvdeg(iip1)
39
40  REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
41  REAL acoslat,dxkm,dykm,resol(iip1,jjp1)
42  REAL,DIMENSION(iip1,jjp1)  :: phis_loc
43  INTEGER masque_int(iip1,jjp1)
44  INTEGER :: phis_id
45  INTEGER :: area_id
46  INTEGER :: mask_id
47  INTEGER :: presnivs_id
48 
49  rad = 6400000
50  omeg = 7.272205e-05
51  g = 9.8
52  kappa = 0.285716
53  daysec = 86400
54  cpp = 1004.70885
55
56  preff = 101325.
57  pa= 50000.
58
59  CALL conf_gcm( 99, .TRUE. )
60  CALL iniconst
61  CALL inigeom
62
63  DO j=1,jjp1
64     rlatudeg(j)=rlatu(j)*180./pi
65  ENDDO
66  DO j=1,jjm
67     rlatvdeg(j)=rlatv(j)*180./pi
68  ENDDO
69
70  DO i=1,iip1
71     rlonudeg(i)=rlonu(i)*180./pi + 360.
72     rlonvdeg(i)=rlonv(i)*180./pi + 360.
73  ENDDO
74
75
76  !  2 ----- OUVERTURE DE LA SORTIE NETCDF
77  ! ---------------------------------------------------
78  ! CREATION OUTPUT
79  ! ouverture fichier netcdf de sortie out
80  status=NF_CREATE('grilles_gcm.nc',NF_CLOBBER,ncid_out)
81  CALL handle_err(status)
82  status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
83  CALL handle_err(status)
84  status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim)
85  CALL handle_err(status)
86  status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim)
87  CALL handle_err(status)
88  status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
89  CALL handle_err(status)
90
91
92  !   Longitudes en u
93  status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, out_lonuid)
94  CALL handle_err(status)
95  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', 12,'degrees_east')
96  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',9,'Longitude en u')
97
98  !   Longitudes en v
99  status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, out_lonvid)
100  CALL handle_err(status)
101  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', 12,'degrees_east')
102  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 9,'Longitude en v')
103
104  !   Latitude en u
105  status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, out_latuid)
106  CALL handle_err(status)
107  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', 13,'degrees_north')
108  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 8,'Latitude en u')
109
110  !  Latitude en v
111  status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, out_latvid)
112  CALL handle_err(status)
113  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', 13,'degrees_north')
114  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 8,'Latitude en v')
115
116  !   ecriture de la grille u
117  out_dim(1)=out_lonudim
118  out_dim(2)=out_latudim
119  status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, out_varid)
120  CALL handle_err(status)
121  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
122  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point u')
123
124  !   ecriture de la grille v
125  out_dim(1)=out_lonvdim
126  out_dim(2)=out_latvdim
127  status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, out_varid)
128  CALL handle_err(status)
129  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
130  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point v')
131
132  !   ecriture de la grille u
133  out_dim(1)=out_lonvdim
134  out_dim(2)=out_latudim
135  status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim, out_varid)
136  CALL handle_err(status)
137  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
138  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',16,'Grille aux point u')
139
140  status=NF_ENDDEF(ncid_out)
141  write(*,*) "COUCOU 6"
142  CALL handle_err(status)
143  ! 5) ----- FERMETURE DES FICHIERS NETCDF------------------
144  ! --------------------------------------------------------
145  ! 3-b- Ecriture de la grille pour la sortie
146  ! rajoute l'ecriture de la grille
147
148#ifdef NC_DOUBLE
149  status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg)
150  CALL handle_err(status)
151  status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
152  CALL handle_err(status)
153  status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg)
154  CALL handle_err(status)
155  status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg)
156  CALL handle_err(status)
157#else
158  status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
159  CALL handle_err(status)
160  status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
161  CALL handle_err(status)
162  status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
163  CALL handle_err(status)
164  status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
165  CALL handle_err(status)
166#endif
167
168  start(1)=1
169  start(2)=1
170  start(3)=1
171  start(4)=1
172
173  COUNT(1)=iim+1
174  COUNT(2)=jjm+1
175  COUNT(3)=1
176  COUNT(4)=1
177
178  DO j=1,jjm+1
179     DO i=1,iim+1
180        temp(i,j)=MOD(i,2)+MOD(j,2)
181     ENDDO
182  ENDDO
183
184#ifdef NC_DOUBLE
185  status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start, count,temp)
186  CALL handle_err(status)
187#else
188  status=NF_PUT_VARA_REAL(ncid_out,out_varid,start, count,temp)
189  CALL handle_err(status)
190#endif
191
192  ! On re-ouvre le fichier pour rajouter 4 nouvelles variables necessaire pour INCA
193! lev - phis - aire - mask
194! rlevdeg(:) = presnivs
195  rlevdeg(:) = presnivs(:)
196  phis_loc(:,:) = phis(:,:)/g
197
198! niveaux de pression verticaux
199  status = NF_REDEF (ncid_out)
200  CALL handle_err(status)
201  status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim)
202  CALL handle_err(status)
203  status=NF_DEF_VAR(ncid_out,'presnivs',NF_FLOAT,1,out_levdim,&
204                    presnivs_id)
205  CALL handle_err(status)
206 
207! fields
208  out_dim(1)=out_lonvdim
209  out_dim(2)=out_latudim
210
211  status = nf_def_var(ncid_out,'phis',NF_FLOAT,2,out_dim,phis_id)
212  CALL handle_err(status)
213  status = nf_def_var(ncid_out,'aire',NF_FLOAT,2,out_dim,area_id)
214  CALL handle_err(status)
215  status = nf_def_var(ncid_out,'mask',NF_INT  ,2,out_dim,mask_id)
216  CALL handle_err(status)
217
218  status=NF_ENDDEF(ncid_out)
219  CALL handle_err(status)
220
221  ! ecriture des variables
222#ifdef NC_DOUBLE
223  status=NF_PUT_VARA_DOUBLE(ncid_out,presnivs_id,1,llm,rlevdeg)
224  CALL handle_err(status)
225#else
226  status=NF_PUT_VARA_REAL(ncid_out,out_levid,1,llm,rlevdeg)
227  CALL handle_err(status)
228#endif
229
230  start(1)=1
231  start(2)=1
232  start(3)=1
233  start(4)=0
234  COUNT(1)=iip1
235  COUNT(2)=jjp1
236  COUNT(3)=1
237  COUNT(4)=0
238
239  status = nf_put_vara_double(ncid_out, phis_id,start,count, phis_loc)
240  CALL handle_err(status)
241  status = nf_put_vara_double(ncid_out, area_id,start,count, aire)
242  CALL handle_err(status)
243  masque_int(:,:) = nINT(masque(:,:))
244  status = nf_put_vara_int(ncid_out, mask_id,start,count,masque_int)
245  CALL handle_err(status)
246 
247  ! fermeture du fichier netcdf
248  CALL ncclos(ncid_out,rcode_out)
249
250END SUBROUTINE grilles_gcm_netcdf_sub
251
252
253
254SUBROUTINE handle_err(status)
255  INCLUDE "netcdf.inc"
256
257  INTEGER status
258  IF (status.NE.nf_noerr) THEN
259     PRINT *,NF_STRERROR(status)
260     CALL abort_gcm('grilles_gcm_netcdf','netcdf error',1)
261  ENDIF
262END SUBROUTINE handle_err
263
Note: See TracBrowser for help on using the repository browser.