source: trunk/LMDZ.TITAN/libf/phytitan/start2archive.F @ 1056

Last change on this file since 1056 was 1056, checked in by slebonnois, 11 years ago

SL: Titan runs ! see DOC/chantiers/commit_importants.log
File size: 11.7 KB
RevLine 
[1056]1c=======================================================================
2      PROGRAM start2archive
3c=======================================================================
4c
5c
6c   Date:    01/1997
7c   ----
8c
9c   Version Venus: 09/2007
10c           Titan: 02/2009
11c
12c   Objet:   Passage des  fichiers netcdf d etat initial "start" et
13c   -----    "startphy" a un fichier netcdf unique "start_archive"
14c
15c=======================================================================
16
17      USE filtreg_mod
18      USE infotrac
19      USE control_mod
20      use cpdet_mod, only: tpot2t
21
22      implicit none
23
24#include "dimensions.h"
25#include "paramet.h"
26#include "comconst.h"
27#include "comdissnew.h"
28#include "comvert.h"
29#include "comgeom.h"
30#include "logic.h"
31#include "temps.h"
32#include "ener.h"
33#include "description.h"
34#include "dimsoil.h"
35#include "netcdf.inc"
36
37c-----------------------------------------------------------------------
38c   Declarations
39c-----------------------------------------------------------------------
40
41c variables dynamiques du GCM
42c -----------------------------
43      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
44      REAL teta(ip1jmp1,llm)                    ! temperature potentielle
45      REAL, ALLOCATABLE, DIMENSION(:,:,:):: q! champs advectes
46      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
47      REAL pk(ip1jmp1,llm)
48      REAL pkf(ip1jmp1,llm)
49      REAL alpha(iip1,jjp1,llm),beta(iip1,jjp1,llm)
50      REAL phis(ip1jmp1)                     ! geopotentiel au sol
51      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
52      REAL ps(ip1jmp1)                       ! pression au sol
53      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
54     
55c Variable Physiques (grille physique)
56c ------------------------------------
57      integer ngridmx,nlayermx
58      parameter (ngridmx=(2+(jjm-1)*iim - 1/jjm))
59      parameter (nlayermx=llm)
60
61      real rlat(ngridmx),rlon(ngridmx)
62      REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx)
63      REAL albe(ngridmx),radsol(ngridmx),sollw(ngridmx)
64      real solsw(ngridmx),dlw(ngridmx)
65      REAL zmea(ngridmx), zstd(ngridmx)
66      REAL zsig(ngridmx), zgam(ngridmx), zthe(ngridmx)
67      REAL zpic(ngridmx), zval(ngridmx)
68     
69      INTEGER start,length
70      PARAMETER (length = 100)
71      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
72      REAL tab_cntrl_dyn(length) ! tableau des parametres de start
73      INTEGER*4 day_ini_fi
74
75c Variable naturelle / grille scalaire
76c ------------------------------------
77      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
78      REAL tsurfS(ip1jmp1),tsoilS(ip1jmp1,nsoilmx)
79      real rlatS(ip1jmp1),rlonS(ip1jmp1)
80      real albeS(ip1jmp1),radsolS(ip1jmp1),sollwS(ip1jmp1)
81      real solswS(ip1jmp1),dlwS(ip1jmp1)
82      real zmeaS(ip1jmp1),zstdS(ip1jmp1),zsigS(ip1jmp1)
83      real zgamS(ip1jmp1),ztheS(ip1jmp1),zpicS(ip1jmp1)
84      real zvalS(ip1jmp1)
85     
86c Variables intermediaires : vent naturel, mais pas coord scalaire
87c----------------------------------------------------------------
88      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
89
90c Autres  variables
91c -----------------
92      REAL ptotal
93
94      CHARACTER*2 str2
95
96      INTEGER ij, l,i,j,isoil,iq
97      character*80      fichnom
98      integer :: ierr
99
100c Netcdf
101c-------
102      integer varid,dimid
103      INTEGER nid
104
105c-----------------------------------------------------------------------
106c   Initialisations
107c-----------------------------------------------------------------------
108
109c VENUS/TITAN
110
111        iflag_trac = 1
112c-----------------------------------------------------------------------
113c   Initialisation des traceurs
114c   ---------------------------
115c  Choix du nombre de traceurs et du schema pour l advection
116c  dans fichier traceur.def, par default ou via INCA
117      call infotrac_init
118
119c Allocation de la tableau q : champs advectes   
120      allocate(q(ip1jmp1,llm,nqtot))
121
122c=======================================================================
123c Lecture des donnees
124c=======================================================================
125
126      fichnom = 'start.nc'
127      CALL readstart(fichnom,nqtot,vcov,ucov,teta,q,masse,
128     .       ps,phis,tab_cntrl_dyn)
129
130      fichnom = 'startphy.nc'
131      CALL readstartphy(fichnom,
132     .       rlat,rlon,tsurf,tsoil,
133     .       albe, solsw, sollw,
134     .       dlw,radsol,
135     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,
136     .       tab_cntrl_fi)
137
138c-----------------------------------------------------------------------
139c   Initialisations
140c-----------------------------------------------------------------------
141
142      call iniconst
143      call inigeom
144      call inifilr
145      CALL pression(ip1jmp1, ap, bp, ps, p3d)
146         if (disvert_type==1) then
147           CALL exner_hyb(  ip1jmp1, ps, p3d,alpha,beta,pks, pk, pkf )
148         else ! we assume that we are in the disvert_type==2 case
149           CALL exner_milieu( ip1jmp1, ps, p3d, beta, pks, pk, pkf )
150         endif
151
152c=======================================================================
153c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
154c=======================================================================
155c  Les variables modeles dependent de la resolution. Il faut donc
156c  eliminer les facteurs responsables de cette dependance
157c  (pour utiliser newstart)
158c=======================================================================
159
160c-----------------------------------------------------------------------
161c Vent   (depend de la resolution horizontale)
162c-----------------------------------------------------------------------
163c
164c ucov --> un  et  vcov --> vn
165c un --> us  et   vn --> vs
166c
167c-----------------------------------------------------------------------
168
169      call covnat(llm,ucov, vcov, un, vn)
170      call wind_scal(un,vn,us,vs)
171
172c-----------------------------------------------------------------------
173c Temperature  (depend de la resolution verticale => de "sigma.def")
174c-----------------------------------------------------------------------
175c
176c h --> T
177c
178c-----------------------------------------------------------------------
179! ADAPTATION GCM POUR CP(T)
180
181      call tpot2t(ip1jmp1*llm,teta,T,pk)
182
183c-----------------------------------------------------------------------
184c Variable physique
185c-----------------------------------------------------------------------
186c
187c tsurf --> tsurfS
188c et autres...
189c
190c-----------------------------------------------------------------------
191
192      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
193      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
194      call gr_fi_dyn(1,ngridmx,iip1,jjp1,rlat,rlatS)
195      call gr_fi_dyn(1,ngridmx,iip1,jjp1,rlon,rlonS)
196      call gr_fi_dyn(1,ngridmx,iip1,jjp1,albe,albeS)
197      call gr_fi_dyn(1,ngridmx,iip1,jjp1,radsol,radsolS)
198      call gr_fi_dyn(1,ngridmx,iip1,jjp1,sollw,sollwS)
199      call gr_fi_dyn(1,ngridmx,iip1,jjp1,solsw,solswS)
200      call gr_fi_dyn(1,ngridmx,iip1,jjp1,dlw,dlwS)
201      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zmea,zmeaS)
202      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zstd,zstdS)
203      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zsig,zsigS)
204      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zgam,zgamS)
205      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zthe,ztheS)
206      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zpic,zpicS)
207      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zval,zvalS)
208
209c=======================================================================
210c Info pour controler
211c=======================================================================
212
213      ptotal =  0.
214      DO j=1,jjp1
215         DO i=1,iim
216           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
217         ENDDO
218      ENDDO
219      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
220
221c-----------------------------------------------------------------------
222c Passage de "ptotal" par tab_cntrl_fi
223c-----------------------------------------------------------------------
224
225      tab_cntrl_fi(length) = ptotal
226
227c=======================================================================
228c Ecriture dans le fichier  "start_archive"
229c=======================================================================
230
231c-----------------------------------------------------------------------
232c Ouverture de "start_archive"
233c-----------------------------------------------------------------------
234
235      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
236 
237c-----------------------------------------------------------------------
238c  si "start_archive" n'existe pas:
239c    1_ ouverture
240c    2_ creation de l'entete dynamique ("ini_archive")
241c-----------------------------------------------------------------------
242c ini_archive:
243c On met dans l'entete le tab_cntrl_dyn (1 a length)
244c  On y ajoute les valeurs du tab_cntrl_fi (length+1 a 2*length)
245c-----------------------------------------------------------------------
246
247      if (ierr.ne.NF_NOERR) then
248         write(*,*)'OK, Could not open file "start_archive.nc"'
249         write(*,*)'So let s create a new "start_archive"'
250         ierr = NF_CREATE('start_archive.nc', NF_CLOBBER, nid)
251         call ini_archive(nid,phis,tab_cntrl_dyn,tab_cntrl_fi)
252      else
253         write(*,*)'Attention, start_archive.nc existe deja...'
254         call abort
255      endif
256
257c-----------------------------------------------------------------------
258c Ecriture des champs
259c-----------------------------------------------------------------------
260
261      call write_archive(nid,'u','Vent zonal','m.s-1',3,us)
262      call write_archive(nid,'v','Vent merid','m.s-1',3,vs)
263      call write_archive(nid,'temp','temperature','K',3,T)
264c-----------------------------------------------------------------------
265c Ecriture du champs  q  ( q[1,nqtot] )
266c-----------------------------------------------------------------------
267       do iq=1,nqtot
268        write(str2,'(i2.2)') iq
269         call write_archive(nid,tname(iq),'tracer','kg/kg',
270     .         3,q(1,1,iq))
271       end do
272c-----------------------------------------------------------------------
273      call write_archive(nid,'masse','Masse','kg',3,masse)
274      call write_archive(nid,'ps','Psurf','Pa',2,ps)
275      call write_archive(nid,'tsurf','surf T','K',2,tsurfS)
276c-----------------------------------------------------------------------
277c Ecriture du champs  tsoil  ( Tsoil[1,nsoilmx] )
278c-----------------------------------------------------------------------
279c "tsoil" Temperature au sol definie dans nsoilmx couches dans le sol
280c   Les nsoilmx couches sont lues comme nsoilmx champs
281c  nommees Tsoil[1,nsoilmx]
282      do isoil=1,nsoilmx
283       write(str2,'(i2.2)') isoil
284       call write_archive(nid,'Tsoil'//str2,'Ground Temperature ',
285     .   'K',2,tsoilS(1,isoil))
286      enddo
287c-----------------------------------------------------------------------
288      call write_archive(nid,'rlat','Latitude','rad',2,rlatS)
289      call write_archive(nid,'rlon','Longitude','rad',2,rlonS)
290      call write_archive(nid,'albe','Albedo','',2,albeS)
291      call write_archive(nid,'radsol',
292     .             'Net flux at surface','W m-2',2,radsolS)
293      call write_archive(nid,'sollw',
294     .             'LW flux at surface','W m-2',2,sollwS)
295      call write_archive(nid,'solsw',
296     .             'SW flux at surface','W m-2',2,solswS)
297      call write_archive(nid,'dlw','LW derive','?',2,dlwS)
298      call write_archive(nid,'zmea','param oro sous-maille','m',2,zmeaS)
299      call write_archive(nid,'zstd','param oro sous-maille','m',2,zstdS)
300      call write_archive(nid,'zsig','param oro sous-maille','m',2,zsigS)
301      call write_archive(nid,'zgam','param oro sous-maille','m',2,zgamS)
302      call write_archive(nid,'zthe','param oro sous-maille','m',2,ztheS)
303      call write_archive(nid,'zpic','param oro sous-maille','m',2,zpicS)
304      call write_archive(nid,'zval','param oro sous-maille','m',2,zvalS)
305
306      ierr=NF_CLOSE(nid)
307
308c-----------------------------------------------------------------------
309c Fin
310c-----------------------------------------------------------------------
311
312      end
Note: See TracBrowser for help on using the repository browser.