source: trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive.F @ 2828

Last change on this file since 2828 was 2828, checked in by romain.vande, 2 years ago

Mars newstart and startarchive:
Same as previous commit for newstart and startarchive.
The variable co2ice is deleted. All the co2 ice on surface is now in qsurf(:,igcm_co2).
CO2 tracer is now mandatory. diagfi output is unchanged.
RV
File size: 15.8 KB
Line 
1c=======================================================================
2      PROGRAM start2archive
3c=======================================================================
4c
5c
6c   Date:    01/1997
7c   ----
8c
9c
10c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
11c   -----    "startfi" a un fichier netcdf unique "start_archive"
12c
13c  "start_archive" est une banque d'etats initiaux:
14c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
15c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
16c
17c
18c
19c=======================================================================
20
21      use infotrac, only: infotrac_init, nqtot, tname
22      use comsoil_h, only: nsoilmx, inertiedat
23      use surfdat_h, only: ini_surfdat_h, qsurf
24      use comsoil_h, only: ini_comsoil_h
25!      use comgeomphy, only: initcomgeomphy
26      use filtreg_mod, only: inifilr
27      USE mod_const_mpi, ONLY: COMM_LMDZ
28      use control_mod, only: planet_type
29      USE comvert_mod, ONLY: ap,bp
30      USE comconst_mod, ONLY: daysec,dtphys,rad,g,r,cpp
31      USE temps_mod, ONLY: day_ini,hour_ini
32      USE iniphysiq_mod, ONLY: iniphysiq
33      USE phyetat0_mod, ONLY: phyetat0
34      USE exner_hyb_m, ONLY: exner_hyb
35      implicit none
36
37      include "dimensions.h"
38      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)
39      include "paramet.h"
40      include "comdissip.h"
41      include "comgeom.h"
42      include "netcdf.inc"
43
44c-----------------------------------------------------------------------
45c   Declarations
46c-----------------------------------------------------------------------
47
48c variables dynamiques du GCM
49c -----------------------------
50      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
51      REAL teta(ip1jmp1,llm)                    ! temperature potentielle
52      REAL,ALLOCATABLE :: q(:,:,:)   ! champs advectes
53      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
54      REAL pk(ip1jmp1,llm)
55      REAL pkf(ip1jmp1,llm)
56      REAL phis(ip1jmp1)                     ! geopotentiel au sol
57      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
58      REAL ps(ip1jmp1)                       ! pression au sol
59      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
60     
61c Variable Physiques (grille physique)
62c ------------------------------------
63      REAL tsurf(ngridmx)        ! Surface temperature
64      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
65      REAL watercap(ngridmx)        ! h2o ice layer
66      REAL tauscaling(ngridmx) ! dust conversion factor
67      REAL totcloudfrac(ngridmx) ! sub-grid cloud fraction
68      REAL q2(ngridmx,llm+1)
69      REAL emis(ngridmx)
70      REAL albedo(ngridmx,2)
71      REAL wstar(ngridmx)
72      INTEGER start,length
73      PARAMETER (length = 100)
74      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
75      INTEGER*4 day_ini_fi
76
77c Variable naturelle / grille scalaire
78c ------------------------------------
79      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
80      REAL tsurfS(ip1jmp1)
81      REAL tsoilS(ip1jmp1,nsoilmx)
82      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
83      REAL watercapS(ip1jmp1)
84      REAL tauscalingS(ip1jmp1)
85      REAL totcloudfracS(ip1jmp1)
86      REAL q2S(ip1jmp1,llm+1)
87      REAL,ALLOCATABLE :: qsurfS(:,:)
88      REAL emisS(ip1jmp1)
89      REAL albedoS(ip1jmp1)
90
91c Variables intermediaires : vent naturel, mais pas coord scalaire
92c----------------------------------------------------------------
93      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
94
95c Autres  variables
96c -----------------
97      LOGICAL startdrs
98      INTEGER Lmodif
99
100      REAL ptotal, co2icetotal
101      REAL timedyn,timefi !fraction du jour dans start, startfi
102      REAL date
103
104      CHARACTER*2 str2
105      CHARACTER*80 fichier
106      data  fichier /'startfi'/
107
108      INTEGER ij, l,i,j,isoil,iq
109      character*80      fichnom
110      integer :: ierr,ntime
111      integer :: igcm_co2
112      integer :: nq,numvanle
113      character(len=30) :: txt ! to store some text
114
115c Netcdf
116c-------
117      integer varid,dimid,timelen
118      INTEGER nid,nid1
119
120c-----------------------------------------------------------------------
121c   Initialisations
122c-----------------------------------------------------------------------
123
124      CALL defrun_new(99, .TRUE. )
125
126      planet_type='mars'
127
128c=======================================================================
129c Lecture des donnees
130c=======================================================================
131! Load tracer number and names:
132      call infotrac_init
133
134! allocate arrays:
135      allocate(q(ip1jmp1,llm,nqtot))
136      allocate(qsurfS(ip1jmp1,nqtot))
137     
138
139      fichnom = 'start.nc'
140      CALL dynetat0(fichnom,vcov,ucov,teta,q,masse,
141     .       ps,phis,timedyn)
142
143c-----------------------------------------------------------------------
144c   Initialisations
145c-----------------------------------------------------------------------
146
147      CALL defrun_new(99, .FALSE. )
148      call iniconst
149      call inigeom
150      call inifilr
151
152! Initialize the physics
153         CALL iniphysiq(iim,jjm,llm,
154     &                  (jjm-1)*iim+2,comm_lmdz,
155     &                  daysec,day_ini,dtphys,
156     &                  rlatu,rlatv,rlonu,rlonv,
157     &                  aire,cu,cv,rad,g,r,cpp,
158     &                  1)
159
160      fichnom = 'startfi.nc'
161      Lmodif=0
162
163      CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
164     &      day_ini_fi,timefi,tsurf,tsoil,albedo,emis,q2,qsurf,
165     &      tauscaling,totcloudfrac,wstar,watercap)
166
167       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
168       IF (ierr.NE.NF_NOERR) THEN
169         write(6,*)' Pb d''ouverture du fichier'//fichnom
170        CALL ABORT
171       ENDIF
172                                               
173      ierr = NF_INQ_VARID (nid1, "controle", varid)
174      IF (ierr .NE. NF_NOERR) THEN
175       PRINT*, "start2archive: Le champ <controle> est absent"
176       CALL abort
177      ENDIF
178#ifdef NC_DOUBLE
179       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
180#else
181      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
182#endif
183       IF (ierr .NE. NF_NOERR) THEN
184          PRINT*, "start2archive: Lecture echoue pour <controle>"
185          CALL abort
186       ENDIF
187
188      ierr = NF_CLOSE(nid1)
189
190c-----------------------------------------------------------------------
191c Controle de la synchro
192c-----------------------------------------------------------------------
193!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10))
194      if ((mod(day_ini_fi,669).ne.mod(day_ini,669)))
195     &  stop ' Probleme de Synchro entre start et startfi !!!'
196
197
198c *****************************************************************
199c    Option : Reinitialisation des dates dans la premieres annees :
200       do while (day_ini.ge.669)
201          day_ini=day_ini-669
202       enddo
203c *****************************************************************
204
205      CALL pression(ip1jmp1, ap, bp, ps, p3d)
206      call exner_hyb(ip1jmp1, ps, p3d, pks, pk, pkf)
207
208c=======================================================================
209c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
210c=======================================================================
211c  Les variables modeles dependent de la resolution. Il faut donc
212c  eliminer les facteurs responsables de cette dependance
213c  (pour utiliser newstart)
214c=======================================================================
215
216c-----------------------------------------------------------------------
217c Vent   (depend de la resolution horizontale)
218c-----------------------------------------------------------------------
219c
220c ucov --> un  et  vcov --> vn
221c un --> us  et   vn --> vs
222c
223c-----------------------------------------------------------------------
224
225      call covnat(llm,ucov, vcov, un, vn)
226      call wind_scal(un,vn,us,vs)
227
228c-----------------------------------------------------------------------
229c Temperature  (depend de la resolution verticale => de "sigma.def")
230c-----------------------------------------------------------------------
231c
232c h --> T
233c
234c-----------------------------------------------------------------------
235
236      DO l=1,llm
237         DO ij=1,ip1jmp1
238            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
239         ENDDO
240      ENDDO
241
242c-----------------------------------------------------------------------
243c Variable physique
244c-----------------------------------------------------------------------
245c
246c tsurf --> tsurfS
247c watercap --> watercapS
248c tsoil --> tsoilS
249c inertiedat --> ithS
250c emis --> emisS
251c albedo --> albedoS
252c q2 --> q2S
253c qsurf --> qsurfS
254c tauscaling --> tauscalingS
255c totcloudfrac --> totcloudfracS
256c
257c-----------------------------------------------------------------------
258
259      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
260      call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercap,watercapS)
261      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
262      ! Note: thermal inertia "inertiedat" is in comsoil.h
263      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
264      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
265      call gr_fi_dyn(1,ngridmx,iip1,jjp1,albedo(:,1),albedoS)
266      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
267      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
268      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS)
269      call gr_fi_dyn(1,ngridmx,iip1,jjp1,totcloudfrac,totcloudfracS)
270
271c=======================================================================
272c Info pour controler
273c=======================================================================
274
275      DO iq=1,nqtot
276        if (trim(tname(iq)) .eq. "co2") then
277           igcm_co2=iq
278        endif
279      enddo
280
281      ptotal =  0.
282      co2icetotal = 0.
283      DO j=1,jjp1
284         DO i=1,iim
285           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
286           co2icetotal = co2icetotal +
287     &            qsurfS(i+(iim+1)*(j-1),igcm_co2)*aire(i+(iim+1)*(j-1))
288         ENDDO
289      ENDDO
290      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
291      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
292
293c-----------------------------------------------------------------------
294c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
295c-----------------------------------------------------------------------
296
297      tab_cntrl_fi(49) = ptotal
298      tab_cntrl_fi(50) = co2icetotal
299
300c=======================================================================
301c Ecriture dans le fichier  "start_archive"
302c=======================================================================
303
304c-----------------------------------------------------------------------
305c Ouverture de "start_archive"
306c-----------------------------------------------------------------------
307
308      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
309 
310c-----------------------------------------------------------------------
311c  si "start_archive" n'existe pas:
312c    1_ ouverture
313c    2_ creation de l'entete dynamique ("ini_archive")
314c-----------------------------------------------------------------------
315c ini_archive:
316c On met dans l'entete le tab_cntrl dynamique (1 a 16)
317c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
318c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
319c-----------------------------------------------------------------------
320
321      if (ierr.ne.NF_NOERR) then
322         write(*,*)'OK, Could not open file "start_archive.nc"'
323         write(*,*)'So let s create a new "start_archive"'
324         ierr = NF_CREATE('start_archive.nc',
325     &  IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
326         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi)
327      endif
328
329c-----------------------------------------------------------------------
330c Ecriture de la coordonnee temps (date en jours)
331c-----------------------------------------------------------------------
332
333      date = day_ini + hour_ini
334      ierr= NF_INQ_VARID(nid,"Time",varid)
335      ierr= NF_INQ_DIMID(nid,"Time",dimid)
336      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
337      ntime=timelen+1
338
339      write(*,*) "******************"
340      write(*,*) "ntime",ntime
341      write(*,*) "******************"
342#ifdef NC_DOUBLE
343      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
344#else
345      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
346#endif
347      if (ierr.ne.NF_NOERR) then
348         write(*,*) "time matter ",NF_STRERROR(ierr)
349         stop
350      endif
351
352c-----------------------------------------------------------------------
353c Ecriture des champs  (co2ice,emis,albedo,ps,Tsurf,T,u,v,q2,q,qsurf)
354c-----------------------------------------------------------------------
355c ATTENTION: q2 a une couche de plus!!!!
356c    Pour creer un fichier netcdf lisible par grads,
357c    On passe donc une des couches de q2 a part
358c    comme une variable 2D (la couche au sol: "q2surf")
359c    Les lmm autres couches sont nommees "q2atm" (3D)
360c-----------------------------------------------------------------------
361
362      call write_archive(nid,ntime,'watercap','couche de glace h2o',
363     &  'kg/m2',2,watercapS)
364      call write_archive(nid,ntime,'tauscaling',
365     &  'dust conversion factor',' ',2,tauscalingS)
366      call write_archive(nid,ntime,'totcloudfrac',
367     &  'sub grid cloud fraction',' ',2,totcloudfracS)
368      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
369      call write_archive(nid,ntime,'albedo','surface albedo',' ',
370     &                             2,albedoS)
371      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
372      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
373      call write_archive(nid,ntime,'temp','temperature','K',3,t)
374      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
375      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
376      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
377     .              q2S)
378      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
379     .              q2S(1,2))
380
381c-----------------------------------------------------------------------
382c Ecriture du champs  q  ( q[1,nqtot] )
383c-----------------------------------------------------------------------
384      do iq=1,nqtot
385c       write(str2,'(i2.2)') iq
386c        call write_archive(nid,ntime,'q'//str2,'tracer','kg/kg',
387c     .         3,q(1,1,iq))
388        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
389     &         3,q(1,1,iq))
390      end do
391c-----------------------------------------------------------------------
392c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
393c-----------------------------------------------------------------------
394      do iq=1,nqtot
395c       write(str2,'(i2.2)') iq
396c       call write_archive(nid,ntime,'qsurf'//str2,'Tracer on surface',
397c     $  'kg.m-2',2,qsurfS(1,iq))
398        txt=trim(tname(iq))//"_surf"
399        call write_archive(nid,ntime,txt,'Tracer on surface',
400     &  'kg.m-2',2,qsurfS(1,iq))
401      enddo
402
403
404c-----------------------------------------------------------------------
405c Ecriture du champs  tsoil  ( Tg[1,10] )
406c-----------------------------------------------------------------------
407c "tsoil" Temperature au sol definie dans 10 couches dans le sol
408c   Les 10 couches sont lues comme 10 champs
409c  nommees Tg[1,10]
410
411c      do isoil=1,nsoilmx
412c       write(str2,'(i2.2)') isoil
413c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
414c     .   'K',2,tsoilS(1,isoil))
415c      enddo
416
417! Write soil temperatures tsoil
418      call write_archive(nid,ntime,'tsoil','Soil temperature',
419     &     'K',-3,tsoilS)
420
421! Write soil thermal inertia
422      call write_archive(nid,ntime,'inertiedat',
423     &     'Soil thermal inertia',
424     &     'J.s-1/2.m-2.K-1',-3,ithS)
425
426! Write (0D) volumetric heat capacity (stored in comsoil.h)
427!      call write_archive(nid,ntime,'volcapa',
428!     &     'Soil volumetric heat capacity',
429!     &     'J.m-3.K-1',0,volcapa)
430! Note: no need to write volcapa, it is stored in "controle" table
431
432      ierr=NF_CLOSE(nid)
433c-----------------------------------------------------------------------
434c Fin
435c-----------------------------------------------------------------------
436
437      write(*,*) "startarchive: all is well that ends well"
438     
439      end
Note: See TracBrowser for help on using the repository browser.