source: LMDZ5/trunk/libf/dyn3dpar/grilles_gcm_netcdf_sub.F90 @ 1495

Last change on this file since 1495 was 1492, checked in by Laurent Fairhead, 14 years ago

Merge of development branch LMDZ5V2.0-dev r1455:r1491 into the trunk.
Validation made locally: restart files are strictly equal between the HEAD of the trunk
and r1491 of LMDZ5V2.0-dev


Synchro de la branche de développement LMDZ5V2.0-dev r1455:r1491 et de la trunk
Validation faite en local: les fichiers restart sont équivalents entre la HEAD de la trunk
et la révision r1491 de LMDZ5V2.0-dev

File size: 5.3 KB
Line 
1!
2! $Header$
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
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  REAL temp(iim+1,jjm+1)
22  ! Attributs netcdf sortie
23  INTEGER ncid_out,rcode_out
24  INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid
25  INTEGER out_varid
26  INTEGER out_lonudim,out_lonvdim
27  INTEGER out_latudim,out_latvdim,out_dim(3)
28
29  INTEGER, PARAMETER :: longcles = 20
30  REAL  clesphy0(longcles)
31
32  INTEGER start(4),COUNT(4)
33
34  INTEGER status,i,j
35  REAL rlatudeg(jjp1),rlatvdeg(jjm)
36  REAL rlonudeg(iip1),rlonvdeg(iip1)
37
38  REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
39  REAL acoslat,dxkm,dykm,resol(iip1,jjp1)
40
41  rad = 6400000
42  omeg = 7.272205e-05
43  g = 9.8
44  kappa = 0.285716
45  daysec = 86400
46  cpp = 1004.70885
47
48  preff = 101325.
49  pa= 50000.
50
51  CALL conf_gcm( 99, .TRUE. , clesphy0 )
52  CALL iniconst
53  CALL inigeom
54
55  DO j=1,jjp1
56     rlatudeg(j)=rlatu(j)*180./pi
57  ENDDO
58  DO j=1,jjm
59     rlatvdeg(j)=rlatv(j)*180./pi
60  ENDDO
61
62  DO i=1,iip1
63     rlonudeg(i)=rlonu(i)*180./pi + 360.
64     rlonvdeg(i)=rlonv(i)*180./pi + 360.
65  ENDDO
66
67
68  !  2 ----- OUVERTURE DE LA SORTIE NETCDF
69  ! ---------------------------------------------------
70  ! CREATION OUTPUT
71  ! ouverture fichier netcdf de sortie out
72  status=NF_CREATE('grilles_gcm.nc',NF_NOCLOBBER,ncid_out)
73  status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
74  status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim)
75  status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim)
76  status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
77
78
79  !   Longitudes en u
80  status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, out_lonuid)
81  CALL handle_err(status)
82  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', 12,'degrees_east')
83  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',9,'Longitude en u')
84
85  !   Longitudes en v
86  status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, out_lonvid)
87  CALL handle_err(status)
88  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', 12,'degrees_east')
89  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 9,'Longitude en v')
90
91  !   Latitude en u
92  status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, out_latuid)
93  CALL handle_err(status)
94  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', 13,'degrees_north')
95  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 8,'Latitude en u')
96
97  !  Latitude en v
98  status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, out_latvid)
99  CALL handle_err(status)
100  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', 13,'degrees_north')
101  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 8,'Latitude en v')
102
103  !   ecriture de la grille u
104  out_dim(1)=out_lonudim
105  out_dim(2)=out_latudim
106  status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, out_varid)
107  CALL handle_err(status)
108  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
109  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point u')
110
111  !   ecriture de la grille v
112  out_dim(1)=out_lonvdim
113  out_dim(2)=out_latvdim
114  status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, out_varid)
115  CALL handle_err(status)
116  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
117  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point v')
118
119  !   ecriture de la grille u
120  out_dim(1)=out_lonvdim
121  out_dim(2)=out_latudim
122  status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim, out_varid)
123  CALL handle_err(status)
124  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
125  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',16,'Grille aux point u')
126
127  status=NF_ENDDEF(ncid_out)
128  ! 5) ----- FERMETURE DES FICHIERS NETCDF------------------
129  ! --------------------------------------------------------
130  ! 3-b- Ecriture de la grille pour la sortie
131  ! rajoute l'ecriture de la grille
132
133#ifdef NC_DOUBLE
134  status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg)
135  status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
136  status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg)
137  status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg)
138#else
139  status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
140  status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
141  status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
142  status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
143#endif
144
145  start(1)=1
146  start(2)=1
147  start(3)=1
148  start(4)=1
149
150  COUNT(1)=iim+1
151  COUNT(2)=jjm+1
152  COUNT(3)=1
153  COUNT(4)=1
154
155  DO j=1,jjm+1
156     DO i=1,iim+1
157        temp(i,j)=MOD(i,2)+MOD(j,2)
158     ENDDO
159  ENDDO
160
161#ifdef NC_DOUBLE
162  status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start, count,temp)
163#else
164  status=NF_PUT_VARA_REAL(ncid_out,out_varid,start, count,temp)
165#endif
166
167
168  ! fermeture du fichier netcdf
169  CALL ncclos(ncid_out,rcode_out)
170
171END SUBROUTINE grilles_gcm_netcdf_sub
172
173
174
175SUBROUTINE handle_err(status)
176  INCLUDE "netcdf.inc"
177
178  INTEGER status
179  IF (status.NE.nf_noerr) THEN
180     PRINT *,NF_STRERROR(status)
181     CALL abort_gcm('grilles_gcm_netcdf','netcdf error',1)
182  ENDIF
183END SUBROUTINE handle_err
184
Note: See TracBrowser for help on using the repository browser.