source: LMDZ5/branches/LF-private/libf/dyn3dmem/grilles_gcm_netcdf.F @ 5394

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

Phasage de la dynamique parallele localisee (petite memoire) avec le tronc LMDZ4 (HEAD)
Validation effectuee par comparaison des fichiers de sorties debug (u, v, t, q, masse, etc ...) d'une simulation sans physique
faite avec la version du modele donnee par Y. Meurdesoif et la version phasee avec la r1428 (fin du tronc LMDZ4)

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