source: trunk/LMDZ.COMMON/libf/dyn3d/gcm.F @ 1415

Last change on this file since 1415 was 1395, checked in by emillour, 10 years ago

All GCMS:
Some cleanup and tidying on the dynamics/physics interface.
Essentially affects the "iniphysiq" routine in all physics packages.
EM

File size: 18.6 KB
Line 
1!
2! $Id: gcm.F 1446 2010-10-22 09:27:25Z emillour $
3!
4c
5c
6      PROGRAM gcm
7
8#ifdef CPP_IOIPSL
9      USE IOIPSL
10#else
11! if not using IOIPSL, we still need to use (a local version of) getin
12      USE ioipsl_getincom
13#endif
14
15
16#ifdef CPP_XIOS
17    ! ug Pour les sorties XIOS
18        USE wxios
19#endif
20
21      USE filtreg_mod
22      USE infotrac
23      USE control_mod, only: planet_type,nday,day_step,iperiod,iphysiq,
24     &                       raz_date,anneeref,starttime,dayref,
25     &                       ok_dyn_ins,ok_dyn_ave,iecri,periodav,
26     &                       less1day,fractday,ndynstep,nsplit_phys
27      use cpdet_mod, only: ini_cpdet
28
29#ifdef INCA
30! Only INCA needs these informations (from the Earth's physics)
31      USE indice_sol_mod
32#endif
33
34!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
35! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
36! A nettoyer. On ne veut qu'une ou deux routines d'interface
37! dynamique -> physique pour l'initialisation
38! Ehouarn: the following are needed with (parallel) physics:
39#ifdef CPP_PHYS
40!      USE dimphy
41!      USE comgeomphy, ONLY: initcomgeomphy
42#endif
43#ifdef INCA
44      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
45#endif
46!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
47
48      IMPLICIT NONE
49
50c      ......   Version  du 10/01/98    ..........
51
52c             avec  coordonnees  verticales hybrides
53c   avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
54
55c=======================================================================
56c
57c   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
58c   -------
59c
60c   Objet:
61c   ------
62c
63c   GCM LMD nouvelle grille
64c
65c=======================================================================
66c
67c  ... Dans inigeom , nouveaux calculs pour les elongations  cu , cv
68c      et possibilite d'appeler une fonction f(y)  a derivee tangente
69c      hyperbolique a la  place de la fonction a derivee sinusoidale.
70c  ... Possibilite de choisir le schema pour l'advection de
71c        q  , en modifiant iadv dans traceur.def  (MAF,10/02) .
72c
73c      Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
74c      Pour Van-Leer iadv=10
75c
76c-----------------------------------------------------------------------
77c   Declarations:
78c   -------------
79
80#include "dimensions.h"
81#include "paramet.h"
82#include "comconst.h"
83#include "comdissnew.h"
84#include "comvert.h"
85#include "comgeom.h"
86#include "logic.h"
87#include "temps.h"
88!!!!!!!!!!!#include "control.h"
89#include "ener.h"
90#include "description.h"
91#include "serre.h"
92!#include "com_io_dyn.h"
93#include "iniprint.h"
94#include "tracstoke.h"
95#ifdef INCA
96! Only INCA needs these informations (from the Earth's physics)
97!#include "indicesol.h"
98#endif
99
100
101      REAL zdtvr
102
103c   variables dynamiques
104      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
105      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
106      REAL, ALLOCATABLE, DIMENSION(:,:,:):: q! champs advectes
107      REAL ps(ip1jmp1)                       ! pression  au sol
108      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
109      REAL masse(ip1jmp1,llm)                ! masse d'air
110      REAL phis(ip1jmp1)                     ! geopotentiel au sol
111      REAL phi(ip1jmp1,llm)                  ! geopotentiel
112      REAL w(ip1jmp1,llm)                    ! vitesse verticale
113
114c variables dynamiques intermediaire pour le transport
115
116c   variables pour le fichier histoire
117      REAL dtav      ! intervalle de temps elementaire
118
119      REAL time_0
120
121      LOGICAL lafin
122      INTEGER ij,iq,l,i,j
123
124
125      real time_step, t_wrt, t_ops
126
127      LOGICAL first
128
129!      LOGICAL call_iniphys
130!      data call_iniphys/.true./
131
132c+jld variables test conservation energie
133c      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
134C     Tendance de la temp. potentiel d (theta)/ d t due a la
135C     tansformation d'energie cinetique en energie thermique
136C     cree par la dissipation
137      REAL dhecdt(ip1jmp1,llm)
138c      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
139c      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_ec
140      CHARACTER (len=15) :: ztit
141c-jld
142
143
144      character (len=80) :: dynhist_file, dynhistave_file
145      character (len=20) :: modname
146      character (len=80) :: abort_message
147! locales pour gestion du temps
148      INTEGER :: an, mois, jour
149      REAL :: heure
150
151
152c-----------------------------------------------------------------------
153c    variables pour l'initialisation de la physique :
154c    ------------------------------------------------
155!      INTEGER ngridmx
156!      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
157!      REAL zcufi(ngridmx),zcvfi(ngridmx)
158!      REAL latfi(ngridmx),lonfi(ngridmx)
159!      REAL airefi(ngridmx)
160!      SAVE latfi, lonfi, airefi
161
162c-----------------------------------------------------------------------
163c   Initialisations:
164c   ----------------
165
166      abort_message = 'last timestep reached'
167      modname = 'gcm'
168      descript = 'Run GCM LMDZ'
169      lafin    = .FALSE.
170      dynhist_file = 'dyn_hist.nc'
171      dynhistave_file = 'dyn_hist_ave.nc'
172
173
174
175c----------------------------------------------------------------------
176c  lecture des fichiers gcm.def ou run.def
177c  ---------------------------------------
178c
179! Ehouarn: dump possibility of using defrun
180!#ifdef CPP_IOIPSL
181      CALL conf_gcm( 99, .TRUE. )
182      if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm",
183     s "iphysiq must be a multiple of iperiod", 1)
184!#else
185!      CALL defrun( 99, .TRUE. , clesphy0 )
186!#endif
187
188!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
189! Initialisation de XIOS
190!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
191
192#ifdef CPP_XIOS
193        CALL wxios_init("LMDZ")
194#endif
195
196
197!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
198! FH 2008/05/02
199! A nettoyer. On ne veut qu'une ou deux routines d'interface
200! dynamique -> physique pour l'initialisation
201#ifdef CPP_PHYS
202      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
203!      call initcomgeomphy ! now done in iniphysiq
204#endif
205!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
206c
207c Initialisations pour Cp(T) Venus
208      call ini_cpdet
209c
210c-----------------------------------------------------------------------
211c   Choix du calendrier
212c   -------------------
213
214c      calend = 'earth_365d'
215
216#ifdef CPP_IOIPSL
217      if (calend == 'earth_360d') then
218        call ioconf_calendar('360d')
219        write(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
220      else if (calend == 'earth_365d') then
221        call ioconf_calendar('noleap')
222        write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
223      else if (calend == 'earth_366d') then
224        call ioconf_calendar('gregorian')
225        write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
226      else if (calend == 'titan') then
227!        call ioconf_calendar('titan')
228        write(lunout,*)'CALENDRIER CHOISI: Titan'
229        abort_message = 'A FAIRE...'
230        call abort_gcm(modname,abort_message,1)
231      else if (calend == 'venus') then
232!        call ioconf_calendar('venus')
233        write(lunout,*)'CALENDRIER CHOISI: Venus'
234        abort_message = 'A FAIRE...'
235        call abort_gcm(modname,abort_message,1)
236      else
237        abort_message = 'Mauvais choix de calendrier'
238        call abort_gcm(modname,abort_message,1)
239      endif
240#endif
241c-----------------------------------------------------------------------
242
243      IF (type_trac == 'inca') THEN
244#ifdef INCA
245      call init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday,
246     $        nbsrf, is_oce,is_sic,is_ter,is_lic)
247      call init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
248#endif
249      END IF
250c
251c
252c------------------------------------
253c   Initialisation partie parallele
254c------------------------------------
255
256c
257c
258c-----------------------------------------------------------------------
259c   Initialisation des traceurs
260c   ---------------------------
261c  Choix du nombre de traceurs et du schema pour l'advection
262c  dans fichier traceur.def, par default ou via INCA
263      call infotrac_init
264
265c Allocation de la tableau q : champs advectes   
266      allocate(q(ip1jmp1,llm,nqtot))
267
268c-----------------------------------------------------------------------
269c   Lecture de l'etat initial :
270c   ---------------------------
271
272c  lecture du fichier start.nc
273      if (read_start) then
274      ! we still need to run iniacademic to initialize some
275      ! constants & fields, if we run the 'newtonian' or 'SW' cases:
276        if (iflag_phys.ne.1) then
277          CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
278        endif
279
280        CALL dynetat0("start.nc",vcov,ucov,
281     &              teta,q,masse,ps,phis, time_0)
282       
283        ! Load relaxation fields (simple nudging). AS 09/2013
284        ! ---------------------------------------------------
285        if (planet_type.eq."generic") then
286         if (ok_guide) then
287           CALL relaxetat0("relax.nc")
288         endif
289        endif
290 
291c       write(73,*) 'ucov',ucov
292c       write(74,*) 'vcov',vcov
293c       write(75,*) 'teta',teta
294c       write(76,*) 'ps',ps
295c       write(77,*) 'q',q
296
297      endif ! of if (read_start)
298
299      IF (type_trac == 'inca') THEN
300#ifdef INCA
301         call init_inca_dim(klon,llm,iim,jjm,
302     $        rlonu,rlatu,rlonv,rlatv)
303#endif
304      END IF
305
306
307c le cas echeant, creation d un etat initial
308      IF (prt_level > 9) WRITE(lunout,*)
309     .              'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
310      if (.not.read_start) then
311         CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
312      endif
313
314
315c-----------------------------------------------------------------------
316c   Lecture des parametres de controle pour la simulation :
317c   -------------------------------------------------------
318c  on recalcule eventuellement le pas de temps
319
320      IF(MOD(day_step,iperiod).NE.0) THEN
321        abort_message =
322     .  'Il faut choisir un nb de pas par jour multiple de iperiod'
323        call abort_gcm(modname,abort_message,1)
324      ENDIF
325
326      IF(MOD(day_step,iphysiq).NE.0) THEN
327        abort_message =
328     * 'Il faut choisir un nb de pas par jour multiple de iphysiq'
329        call abort_gcm(modname,abort_message,1)
330      ENDIF
331
332      zdtvr    = daysec/REAL(day_step)
333        IF(dtvr.NE.zdtvr) THEN
334         WRITE(lunout,*)
335     .    'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
336        ENDIF
337
338C
339C on remet le calendrier à zero si demande
340c
341      IF (start_time /= starttime) then
342        WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le'
343     &,' fichier restart ne correspond pas à celle lue dans le run.def'
344        IF (raz_date == 1) then
345          WRITE(lunout,*)'Je prends l''heure lue dans run.def'
346          start_time = starttime
347        ELSE
348          call abort_gcm("gcm", "'Je m''arrete'", 1)
349        ENDIF
350      ENDIF
351      IF (raz_date == 1) THEN
352        annee_ref = anneeref
353        day_ref = dayref
354        day_ini = dayref
355        itau_dyn = 0
356        itau_phy = 0
357        time_0 = 0.
358        write(lunout,*)
359     .   'GCM: On reinitialise a la date lue dans gcm.def'
360      ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
361        write(lunout,*)
362     .  'GCM: Attention les dates initiales lues dans le fichier'
363        write(lunout,*)
364     .  ' restart ne correspondent pas a celles lues dans '
365        write(lunout,*)' gcm.def'
366        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
367        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
368        write(lunout,*)' Pas de remise a zero'
369      ENDIF
370
371c      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
372c        write(lunout,*)
373c     .  'GCM: Attention les dates initiales lues dans le fichier'
374c        write(lunout,*)
375c     .  ' restart ne correspondent pas a celles lues dans '
376c        write(lunout,*)' gcm.def'
377c        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
378c        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
379c        if (raz_date .ne. 1) then
380c          write(lunout,*)
381c     .    'GCM: On garde les dates du fichier restart'
382c        else
383c          annee_ref = anneeref
384c          day_ref = dayref
385c          day_ini = dayref
386c          itau_dyn = 0
387c          itau_phy = 0
388c          time_0 = 0.
389c          write(lunout,*)
390c     .   'GCM: On reinitialise a la date lue dans gcm.def'
391c        endif
392c      ELSE
393c        raz_date = 0
394c      endif
395
396#ifdef CPP_IOIPSL
397      mois = 1
398      heure = 0.
399! Ce n'est defini pour l'instant que pour la Terre...
400      if (planet_type.eq.'earth') then
401      call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
402      jH_ref = jD_ref - int(jD_ref)
403      jD_ref = int(jD_ref)
404
405      call ioconf_startdate(INT(jD_ref), jH_ref)
406
407      write(lunout,*)'DEBUG'
408      write(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
409      write(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
410      call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
411      write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
412      write(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
413      else
414! A voir pour Titan et Venus
415        jD_ref=0
416        jH_ref=0
417      write(lunout,*)'A VOIR POUR VENUS ET TITAN: jD_ref, jH_ref'
418      write(lunout,*)jD_ref,jH_ref
419      endif ! planet_type
420#else
421! Ehouarn: we still need to define JD_ref and JH_ref
422! and since we don't know how many days there are in a year
423! we set JD_ref to 0 (this should be improved ...)
424      jD_ref=0
425      jH_ref=0
426#endif
427
428      if (iflag_phys.eq.1) then
429      ! these initialisations have already been done (via iniacademic)
430      ! if running in SW or Newtonian mode
431c-----------------------------------------------------------------------
432c   Initialisation des constantes dynamiques :
433c   ------------------------------------------
434        dtvr = zdtvr
435        CALL iniconst
436
437c-----------------------------------------------------------------------
438c   Initialisation de la geometrie :
439c   --------------------------------
440        CALL inigeom
441
442c-----------------------------------------------------------------------
443c   Initialisation du filtre :
444c   --------------------------
445        CALL inifilr
446      endif ! of if (iflag_phys.eq.1)
447c
448c-----------------------------------------------------------------------
449c   Initialisation de la dissipation :
450c   ----------------------------------
451
452      CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
453     *                tetagdiv, tetagrot , tetatemp, vert_prof_dissip)
454
455c-----------------------------------------------------------------------
456c   Initialisation de la physique :
457c   -------------------------------
458
459      IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
460!      IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) THEN
461!         latfi(1)=rlatu(1)
462!         lonfi(1)=0.
463!         zcufi(1) = cu(1)
464!         zcvfi(1) = cv(1)
465!         DO j=2,jjm
466!            DO i=1,iim
467!               latfi((j-2)*iim+1+i)= rlatu(j)
468!               lonfi((j-2)*iim+1+i)= rlonv(i)
469!               zcufi((j-2)*iim+1+i) = cu((j-1)*iip1+i)
470!               zcvfi((j-2)*iim+1+i) = cv((j-1)*iip1+i)
471!            ENDDO
472!         ENDDO
473!         latfi(ngridmx)= rlatu(jjp1)
474!         lonfi(ngridmx)= 0.
475!         zcufi(ngridmx) = cu(ip1jm+1)
476!         zcvfi(ngridmx) = cv(ip1jm-iim)
477
478         ! build airefi(), mesh area on physics grid
479!         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
480         ! Poles are single points on physics grid
481!         airefi(1)=airefi(1)*iim
482!         airefi(ngridmx)=airefi(ngridmx)*iim
483
484! Initialisation de la physique: pose probleme quand on tourne
485! SANS physique, car iniphysiq.F est dans le repertoire phy[]...
486! Il faut une cle CPP_PHYS
487#ifdef CPP_PHYS
488!         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys,
489!     &                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp,
490!     &                iflag_phys)
491         CALL iniphysiq(iim,jjm,llm,daysec,day_ini,dtphys/nsplit_phys,
492     &                rlatu,rlonv,aire,cu,cv,rad,g,r,cpp,
493     &                iflag_phys)
494#endif
495!         call_iniphys=.false.
496      ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
497
498c  numero de stockage pour les fichiers de redemarrage:
499
500c-----------------------------------------------------------------------
501c   Initialisation des I/O :
502c   ------------------------
503
504      if (nday>=0) then ! standard case
505        day_end=day_ini+nday
506      else ! special case when nday <0, run -nday dynamical steps
507        day_end=day_ini-nday/day_step
508      endif
509      if (less1day) then
510        day_end=day_ini+floor(time_0+fractday)
511      endif
512      if (ndynstep.gt.0) then
513        day_end=day_ini+floor(time_0+float(ndynstep)/float(day_step))
514      endif
515     
516      WRITE(lunout,'(a,i7,a,i7)')
517     &             "run from day ",day_ini,"  to day",day_end
518
519#ifdef CPP_IOIPSL
520! Ce n'est defini pour l'instant que pour la Terre...
521      if (planet_type.eq.'earth') then
522      call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
523      write (lunout,301)jour, mois, an
524      call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
525      write (lunout,302)jour, mois, an
526      else
527! A voir pour Titan et Venus
528      write(lunout,*)'A VOIR POUR VENUS/TITAN: separation en annees...'
529      endif ! planet_type
530
531 301  FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
532 302  FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
533#endif
534
535      if (planet_type=="mars") then
536        ! For Mars we transmit day_ini
537        CALL dynredem0("restart.nc", day_ini, phis)
538      else
539        CALL dynredem0("restart.nc", day_end, phis)
540      endif
541      ecripar = .TRUE.
542
543#ifdef CPP_IOIPSL
544      time_step = zdtvr
545      if (ok_dyn_ins) then
546        ! initialize output file for instantaneous outputs
547        ! t_ops = iecri * daysec ! do operations every t_ops
548        t_ops =((1.0*iecri)/day_step) * daysec 
549        t_wrt = daysec ! iecri * daysec ! write output every t_wrt
550        CALL inithist(day_ref,annee_ref,time_step,
551     &              t_ops,t_wrt)
552      endif
553
554      IF (ok_dyn_ave) THEN
555        ! initialize output file for averaged outputs
556        t_ops = iperiod * time_step ! do operations every t_ops
557        t_wrt = periodav * daysec   ! write output every t_wrt
558        CALL initdynav(day_ref,annee_ref,time_step,
559     &       t_ops,t_wrt)
560      END IF
561      dtav = iperiod*dtvr/daysec
562#endif
563! #endif of #ifdef CPP_IOIPSL
564
565c  Choix des frequences de stokage pour le offline
566c      istdyn=day_step/4     ! stockage toutes les 6h=1jour/4
567c      istdyn=day_step/12     ! stockage toutes les 2h=1jour/12
568      istdyn=day_step/4     ! stockage toutes les 6h=1jour/12
569      istphy=istdyn/iphysiq     
570
571
572c
573c-----------------------------------------------------------------------
574c   Integration temporelle du modele :
575c   ----------------------------------
576
577c       write(78,*) 'ucov',ucov
578c       write(78,*) 'vcov',vcov
579c       write(78,*) 'teta',teta
580c       write(78,*) 'ps',ps
581c       write(78,*) 'q',q
582
583
584      CALL leapfrog(ucov,vcov,teta,ps,masse,phis,q,
585     .              time_0)
586
587      END
588
Note: See TracBrowser for help on using the repository browser.