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

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

petit detail
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.7 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.