source: trunk/LMDZ.COMMON/libf/dynphy_lonlat/phyvenus/start2archive.F @ 3556

Last change on this file since 3556 was 1687, checked in by slebonnois, 8 years ago

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