source: LMDZ.3.3/trunk/libf/dyn3d/grilles_gcm_netcdf.F @ 204

Last change on this file since 204 was 204, checked in by lmdz, 24 years ago

Debogage du guidage et de la version debranchee et abandon de la version
debranchee non-netcdf FH/MAF
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.6 KB
Line 
1c
2c $Header
3c
4
5      PROGRAM create_fausse_var
6C
7      IMPLICIT NONE
8C
9C
10#include "dimensions.h"
11#include "paramet.h"
12#include "comconst.h"
13#include "comgeom.h"
14#include "comvert.h"
15
16      real temp(iim+1,jjm+1)
17#include "netcdf.inc"
18
19c Attributs netcdf sortie
20        character*64 fich_out
21        integer*4 ncid_out,rcode_out
22        integer*4 out_lonuid,out_lonvid,out_latuid,out_latvid
23        integer*4 out_varid
24        integer*4 out_lonudim,out_lonvdim
25        integer*4 out_latudim,out_latvdim,out_dim(3)
26
27      INTEGER         longcles
28      PARAMETER     ( longcles = 20 )
29      REAL  clesphy0( longcles )
30
31      integer start(4),count(4)
32
33        integer status,i,j
34        real rlatudeg(jjp1),rlatvdeg(jjm)
35        real rlonudeg(iip1),rlonvdeg(iip1)
36
37      real dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
38      real acoslat,dxkm,dykm,resol(iip1,jjp1)
39
40#include "serre.h"
41#include "fxyprim.h"
42
43      print*,'OK0'
44
45      rad = 6400000
46      omeg = 7.272205e-05
47      g = 9.8
48      kappa = 0.285716
49      daysec = 86400
50      cpp = 1004.70885
51
52      preff = 101325.
53      pa= 50000.
54
55      open(99,file='run.def',status='old',form='formatted')
56      CALL defrun_new( 99, .TRUE.,clesphy0 )
57      close(99)
58      CALL iniconst
59      CALL inigeom
60
61
62      print*,'OK1'
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
72         rlonvdeg(i)=rlonv(i)*180./pi
73      enddo
74
75
76      print*,'OK2'
77c  2 ----- OUVERTURE DE LA SORTIE NETCDF
78c ---------------------------------------------------
79c CREATION OUTPUT
80c ouverture fichier netcdf de sortie out
81        fich_out='grilles_gcm.nc'
82
83        status=NF_CREATE(fich_out,NF_NOCLOBBER,ncid_out)
84        status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
85        status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim)
86        status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim)
87        status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
88
89
90      print*,'OK3'
91c   Longitudes en u
92        print *,'OUTID: ',ncid_out
93        status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim,
94     %  out_lonuid)
95        call handle_err(status)
96        status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units',
97     %  12,'degrees_east')
98        status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',
99     %  9,'Longitude en u')
100
101c   Longitudes en v
102        print *,'OUTID: ',ncid_out
103        status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim,
104     %  out_lonvid)
105        call handle_err(status)
106        status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units',
107     %  12,'degrees_east')
108        status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name',
109     %  9,'Longitude en v')
110
111c   Latitude en u
112        status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim,
113     %  out_latuid)
114        call handle_err(status)
115        status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units',
116     %  13,'degrees_north')
117        status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name',
118     %  8,'Latitude en u')
119
120c  Latitude en v
121        status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim,
122     %  out_latvid)
123        call handle_err(status)
124        status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units',
125     %  13,'degrees_north')
126        status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name',
127     %  8,'Latitude en v')
128
129c   ecriture de la grille u
130        out_dim(1)=out_lonudim
131        out_dim(2)=out_latudim
132        status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim,
133     %  out_varid)
134        call handle_err(status)
135        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
136     %  6,'Kelvin')
137        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
138     %  16,'Grille aux point u')
139
140c   ecriture de la grille v
141        out_dim(1)=out_lonvdim
142        out_dim(2)=out_latvdim
143        status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim,
144     %  out_varid)
145        call handle_err(status)
146        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
147     %  6,'Kelvin')
148        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
149     %  16,'Grille aux point v')
150
151c   ecriture de la grille u
152        out_dim(1)=out_lonvdim
153        out_dim(2)=out_latudim
154        status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim,
155     %  out_varid)
156        call handle_err(status)
157        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
158     %  6,'Kelvin')
159        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
160     %  16,'Grille aux point u')
161
162
163      print*,'OK4'
164        status=NF_ENDDEF(ncid_out)
165c 5) ----- FERMETURE DES FICHIERS NETCDF------------------
166c --------------------------------------------------------
167c 3-b- Ecriture de la grille pour la sortie
168c rajoute l'ecriture de la grille
169
170        status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
171        status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
172        status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
173        status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
174
175        start(1)=1
176        start(2)=1
177        start(3)=1
178        start(4)=1
179
180        count(1)=iim+1
181        count(2)=jjm+1
182        count(3)=1
183        count(4)=1
184
185        do j=1,jjm+1
186           do i=1,iim+1
187              temp(i,j)=mod(i,2)+mod(j,2)
188           enddo
189        enddo
190
191        status=NF_PUT_VARA_REAL(ncid_out,out_varid,start,
192     s  count,temp)
193
194c fermeture du fichier netcdf
195        call ncclos(ncid_out,rcode_out)
196        write(*,*) 'Fermeture: ',fich_out
197
198
199      print*,'OK5'
200c   Ecriture grads
201      open (20,file='grille.dat',form='unformatted',access='direct'
202     s      ,recl=4*ip1jmp1)
203      write(20,rec=1) ((float(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
204      write(20,rec=2) ((float(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
205      do j=2,jjm
206         dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi
207c        dlat2(j)=180.*fyprim(float(j))/pi
208      enddo
209      do i=2,iip1
210         dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi
211c        dlon2(i)=180.*fxprim(float(i))/pi
212      enddo
213      do j=2,jjm
214         dykm=(rlatv(j)-rlatv(j-1))*6400.
215         acoslat=6400.*cos(rlatu(j))
216         do i=2,iip1
217            dxkm=acoslat*(rlonu(i)-rlonu(i-1))
218            resol(i,j)=sqrt(dykm*dykm+dxkm*dxkm)
219         enddo
220         resol(1,j)=resol(iip1,j)
221      enddo
222      write(20,rec=3) resol
223      dlon1(1)=dlon1(iip1)
224      dlon2(1)=dlon2(iip1)
225      write(20,rec=4) ((dlon1(i),i=1,iip1),j=1,jjp1)
226      write(20,rec=5) ((dlon2(i),i=1,iip1),j=1,jjp1)
227      write(20,rec=6) ((dlat1(j),i=1,iip1),j=1,jjp1)
228      write(20,rec=7) ((dlat2(j),i=1,iip1),j=1,jjp1)
229       
230      open (21,file='grille.ctl',form='formatted')
231
232c   WARNING! on reecrase le fichier .ctl a chaque ecriture
233      write(21,'(a5,1x,a40)')
234     &       'DSET ','^grille.dat'
235
236      write(21,'(a12)') 'UNDEF 1.0E30'
237      write(21,'(a5,1x,a40)') 'TITLE ','grille'
238      call formcoord(21,iip1,rlonv,180./pi,.false.,'XDEF')
239      call formcoord(21,jjp1,rlatu,180./pi,.true.,'YDEF')
240      call formcoord(21,1,0.,1.,.false.,'ZDEF')
241      write(21,'(a4,i10,a30)')
242     &       'TDEF ',1,' LINEAR 23OCT1994 3hr '
243      write(21,'(a4,2x,i5)') 'VARS',7
244      write(21,'(a18)') 'grille 0 99 grille'
245      write(21,'(a18)') 'gril   0 99 gril  '
246      write(21,'(a29)') 'resol   0 99 resolution (km)  '
247      write(21,'(a18)') 'dlon1  0 99 dlon1 '
248      write(21,'(a18)') 'dlon2  0 99 dlon2 '
249      write(21,'(a18)') 'dlat1  0 99 dlat1 '
250      write(21,'(a18)') 'dlat2  0 99 dlat2 '
251      write(21,'(a7)') 'ENDVARS'
252
253
254
255
256
257      print*,'OK6'
258        end
259
260
261
262        subroutine handle_err(status)
263#include "netcdf.inc"
264
265
266        integer status
267        print *,'handle code err: ',NF_NOERR
268        IF (status.NE.nf_noerr) THEN
269                print *,NF_STRERROR(status)
270                stop 'stopped'
271        ENDIF
272        END
273
Note: See TracBrowser for help on using the repository browser.