source: LMDZ5/trunk/libf/dyn3dmem/grilles_gcm_netcdf_sub.F90 @ 1745

Last change on this file since 1745 was 1673, checked in by Laurent Fairhead, 12 years ago

Fin du phasage de la dynamique parallele localisee (petite memoire) avec le tronc LMDZ5 r1671
Il reste quelques routines a verifier (en particulier ce qui touche a l'etude des cas academiques)
et la validation a effectuer


End of the phasing of the localised (low memory) parallel dynamics package with the
LMDZ5 trunk (r1671)
Some routines still need some checking (in particular the academic cases) and some
validation is still required

File size: 6.8 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 if grilles_gcm_netcdf=TRUE. This subroutine corresponds to the first
7! part in the program create_fausse_var.
8!
9SUBROUTINE grilles_gcm_netcdf_sub(masque,phis)
10
11  IMPLICIT NONE
12
13  INCLUDE "dimensions.h"
14  INCLUDE "paramet.h"
15  INCLUDE "comconst.h"
16  INCLUDE "comgeom.h"
17  INCLUDE "comvert.h"
18  INCLUDE "netcdf.inc"
19  INCLUDE "serre.h"
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, PARAMETER :: longcles = 20
35  REAL  clesphy0(longcles)
36
37  INTEGER start(4),COUNT(4)
38
39  INTEGER status,i,j
40  REAL rlatudeg(jjp1),rlatvdeg(jjm),rlevdeg(llm)
41  REAL rlonudeg(iip1),rlonvdeg(iip1)
42
43  REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
44  REAL acoslat,dxkm,dykm,resol(iip1,jjp1)
45  REAL,DIMENSION(iip1,jjp1)  :: phis_loc
46  INTEGER masque_int(iip1,jjp1)
47  INTEGER :: phis_id
48  INTEGER :: area_id
49  INTEGER :: mask_id
50 
51  rad = 6400000
52  omeg = 7.272205e-05
53  g = 9.8
54  kappa = 0.285716
55  daysec = 86400
56  cpp = 1004.70885
57
58  preff = 101325.
59  pa= 50000.
60
61  CALL conf_gcm( 99, .TRUE. , clesphy0 )
62  CALL iniconst
63  CALL inigeom
64
65  DO j=1,jjp1
66     rlatudeg(j)=rlatu(j)*180./pi
67  ENDDO
68  DO j=1,jjm
69     rlatvdeg(j)=rlatv(j)*180./pi
70  ENDDO
71
72  DO i=1,iip1
73     rlonudeg(i)=rlonu(i)*180./pi + 360.
74     rlonvdeg(i)=rlonv(i)*180./pi + 360.
75  ENDDO
76
77
78  !  2 ----- OUVERTURE DE LA SORTIE NETCDF
79  ! ---------------------------------------------------
80  ! CREATION OUTPUT
81  ! ouverture fichier netcdf de sortie out
82  status=NF_CREATE('grilles_gcm.nc',NF_NOCLOBBER,ncid_out)
83  status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
84  status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim)
85  status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim)
86  status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
87
88
89  !   Longitudes en u
90  status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, out_lonuid)
91  CALL handle_err(status)
92  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', 12,'degrees_east')
93  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',9,'Longitude en u')
94
95  !   Longitudes en v
96  status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, out_lonvid)
97  CALL handle_err(status)
98  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', 12,'degrees_east')
99  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 9,'Longitude en v')
100
101  !   Latitude en u
102  status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, out_latuid)
103  CALL handle_err(status)
104  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', 13,'degrees_north')
105  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 8,'Latitude en u')
106
107  !  Latitude en v
108  status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, out_latvid)
109  CALL handle_err(status)
110  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', 13,'degrees_north')
111  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 8,'Latitude en v')
112
113  !   ecriture de la grille u
114  out_dim(1)=out_lonudim
115  out_dim(2)=out_latudim
116  status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, out_varid)
117  CALL handle_err(status)
118  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
119  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point u')
120
121  !   ecriture de la grille v
122  out_dim(1)=out_lonvdim
123  out_dim(2)=out_latvdim
124  status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, out_varid)
125  CALL handle_err(status)
126  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
127  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point v')
128
129  !   ecriture de la grille u
130  out_dim(1)=out_lonvdim
131  out_dim(2)=out_latudim
132  status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim, out_varid)
133  CALL handle_err(status)
134  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
135  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',16,'Grille aux point u')
136
137  status=NF_ENDDEF(ncid_out)
138  ! 5) ----- FERMETURE DES FICHIERS NETCDF------------------
139  ! --------------------------------------------------------
140  ! 3-b- Ecriture de la grille pour la sortie
141  ! rajoute l'ecriture de la grille
142
143#ifdef NC_DOUBLE
144  status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg)
145  status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
146  status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg)
147  status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg)
148#else
149  status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
150  status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
151  status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
152  status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
153#endif
154
155  start(1)=1
156  start(2)=1
157  start(3)=1
158  start(4)=1
159
160  COUNT(1)=iim+1
161  COUNT(2)=jjm+1
162  COUNT(3)=1
163  COUNT(4)=1
164
165  DO j=1,jjm+1
166     DO i=1,iim+1
167        temp(i,j)=MOD(i,2)+MOD(j,2)
168     ENDDO
169  ENDDO
170
171#ifdef NC_DOUBLE
172  status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start, count,temp)
173#else
174  status=NF_PUT_VARA_REAL(ncid_out,out_varid,start, count,temp)
175#endif
176
177  ! On re-ouvre le fichier pour rajouter 4 nouvelles variables necessaire pour INCA
178! lev - phis - aire - mask
179  rlevdeg(:) = presnivs
180  phis_loc(:,:) = phis(:,:)/g
181
182! niveaux de pression verticaux
183  status = NF_REDEF (ncid_out)
184  status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim)
185 
186! fields
187  out_dim(1)=out_lonvdim
188  out_dim(2)=out_latudim
189
190  status = nf_def_var(ncid_out,'phis',NF_FLOAT,2,out_dim,phis_id)
191  CALL handle_err(status)
192  status = nf_def_var(ncid_out,'aire',NF_FLOAT,2,out_dim,area_id)
193  CALL handle_err(status)
194  status = nf_def_var(ncid_out,'mask',NF_INT  ,2,out_dim,mask_id)
195  CALL handle_err(status)
196
197  status=NF_ENDDEF(ncid_out)
198
199  ! ecriture des variables
200#ifdef NC_DOUBLE
201  status=NF_PUT_VARA_DOUBLE(ncid_out,out_levid,1,llm,rlevdeg)
202#else
203  status=NF_PUT_VARA_REAL(ncid_out,out_levid,1,llm,rlevdeg)
204#endif
205
206  start(1)=1
207  start(2)=1
208  start(3)=1
209  start(4)=0
210  COUNT(1)=iip1
211  COUNT(2)=jjp1
212  COUNT(3)=1
213  COUNT(4)=0
214
215  status = nf_put_vara_double(ncid_out, phis_id,start,count, phis_loc)
216  status = nf_put_vara_double(ncid_out, area_id,start,count, aire)
217  masque_int(:,:) = nINT(masque(:,:))
218  status = nf_put_vara_int(ncid_out, mask_id,start,count,masque_int)
219  CALL handle_err(status)
220 
221  ! fermeture du fichier netcdf
222  CALL ncclos(ncid_out,rcode_out)
223
224END SUBROUTINE grilles_gcm_netcdf_sub
225
226
227
228SUBROUTINE handle_err(status)
229  INCLUDE "netcdf.inc"
230
231  INTEGER status
232  IF (status.NE.nf_noerr) THEN
233     PRINT *,NF_STRERROR(status)
234     CALL abort_gcm('grilles_gcm_netcdf','netcdf error',1)
235  ENDIF
236END SUBROUTINE handle_err
237
Note: See TracBrowser for help on using the repository browser.