source: trunk/LMDZ.VENUS/libf/phyvenus/start2archive.F @ 894

Last change on this file since 894 was 849, checked in by emillour, 12 years ago

Work on common dynamics and interfacing with different physics:

  • Put calls to PVtheta in dynamics between CPP_EARTH flags (because it calls tetalevel, which is supposed to be in the physics; only OK for Earth...).
  • Adapted makelmdz script so that one can compile main programs in dyn* or phy* (makelmdz_fcm already capable of doing that).
  • Moved start2archive-VT.F and start2archive-VT.F to phyvenus (as start2archive.F and newstart.F); leave adapting them to Titan for later.
  • Small correction to phyvenus/testphys1d.F (use module control_mod instead of control.h and call disvert_noterre).
  • removed "use histcom" in phyvenus/physiq.F and phytitan/physiq.F ; it is not needed since there is already a "use ioipsl" (and it moreover confused makelmdz_fcm...)
  • Had to add declaration of variable "zlsm1" in phytitan/physiq.F because it is used in "write_hist.h"; but note that it is used while not initialized (but what should it be initialized to?).

EM

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