source: LMDZ6/trunk/libf/phylmd/dyn1d/scm.f90 @ 5296

Last change on this file since 5296 was 5296, checked in by abarral, 43 hours ago

Turn compbl.h into a module
Move calcul_REGDYN.h to obsolete
Create phys_constants_mod.f90

File size: 40.8 KB
Line 
1SUBROUTINE scm
2
3USE compbl_mod_h
4         USE clesphys_mod_h
5      USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar,getin
6   USE phys_state_var_mod, ONLY : phys_state_var_init, phys_state_var_end, &
7       clwcon, detr_therm, &
8       qsol, fevap, z0m, z0h, agesno, &
9       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
10       falb_dir, falb_dif, &
11       ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
12       rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
13       solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, &
14       wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
15       wake_deltaq, wake_deltat, wake_s, awake_s, wake_dens, &
16       awake_dens, cv_gen, wake_cstar, &
17       zgam, zmax0, zmea, zpic, zsig, &
18       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, &
19       ql_ancien, qs_ancien, qbs_ancien, cf_ancien, rvc_ancien, &
20       prlw_ancien, prsw_ancien, prbsw_ancien, prw_ancien, &
21       u10m,v10m,ale_wake,ale_bl_stat, ratqs_inter_
22
23
24   USE dimphy
25   USE surface_data, only : type_ocean,ok_veget
26   USE pbl_surface_mod, only : ftsoil, pbl_surface_init, &
27                                 pbl_surface_final
28   USE fonte_neige_mod, only : fonte_neige_init, fonte_neige_final
29
30   USE infotrac ! new
31   USE control_mod
32   USE indice_sol_mod
33   USE phyaqua_mod
34!  USE mod_1D_cases_read
35   USE mod_1D_cases_read_std
36   !USE mod_1D_amma_read
37   USE print_control_mod, ONLY: lunout, prt_level
38   USE iniphysiq_mod, ONLY: iniphysiq
39   USE mod_const_mpi, ONLY: comm_lmdz
40   USE physiq_mod, ONLY: physiq
41   USE comvert_mod, ONLY: presnivs, ap, bp, dpres,nivsig, nivsigs, pa, &
42                          preff, aps, bps, pseudoalt, scaleheight
43   USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
44                        itau_dyn, itau_phy, start_time, year_len
45   USE phys_cal_mod, ONLY : year_len_phys_cal_mod => year_len
46   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_OUTPUTPHYSSCM
47
48   USE dimensions_mod, ONLY: iim, jjm, llm, ndm
49   USE dimsoil_mod_h, ONLY: nsoilmx
50USE yomcst_mod_h
51implicit none
52
53
54!!      INCLUDE "control.h"
55!      INCLUDE "indicesol.h"
56
57      INCLUDE "compar1d.h"
58      INCLUDE "flux_arp.h"
59      INCLUDE "date_cas.h"
60      INCLUDE "tsoilnudge.h"
61      INCLUDE "fcg_gcssold.h"
62
63!=====================================================================
64! DECLARATIONS
65!=====================================================================
66
67!---------------------------------------------------------------------
68!  Externals
69!---------------------------------------------------------------------
70      external fq_sat
71      real fq_sat
72
73!---------------------------------------------------------------------
74!  Arguments d' initialisations de la physique (USER DEFINE)
75!---------------------------------------------------------------------
76
77      integer, parameter :: ngrid=1
78      real :: zcufi    = 1.
79      real :: zcvfi    = 1.
80      real :: fnday
81      real :: day, daytime
82      real :: day1
83      real :: heure
84      integer :: jour
85      integer :: mois
86      integer :: an
87 
88!---------------------------------------------------------------------
89!  Declarations related to forcing and initial profiles
90!---------------------------------------------------------------------
91
92        integer :: kmax = llm
93        integer llm700,nq1,nq2
94        INTEGER, PARAMETER :: nlev_max=1000, nqmx=1000
95        real timestep, frac
96        real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max)
97        real  uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max)
98        real  ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max)
99        real  dqtdxls(nlev_max),dqtdyls(nlev_max)
100        real  dqtdtls(nlev_max),thlpcar(nlev_max)
101        real  qprof(nlev_max,nqmx)
102
103!        integer :: forcing_type
104        logical :: forcing_les     = .false.
105        logical :: forcing_armcu   = .false.
106        logical :: forcing_rico    = .false.
107        logical :: forcing_radconv = .false.
108        logical :: forcing_toga    = .false.
109        logical :: forcing_twpice  = .false.
110        logical :: forcing_amma    = .false.
111        logical :: forcing_dice    = .false.
112        logical :: forcing_gabls4  = .false.
113
114        logical :: forcing_GCM2SCM = .false.
115        logical :: forcing_GCSSold = .false.
116        logical :: forcing_sandu   = .false.
117        logical :: forcing_astex   = .false.
118        logical :: forcing_fire    = .false.
119        logical :: forcing_case    = .false.
120        logical :: forcing_case2   = .false.
121        logical :: forcing_SCM   = .false.
122
123!flag forcings
124        logical :: nudge_wind=.true.
125        logical :: nudge_thermo=.false.
126        logical :: cptadvw=.true.
127
128
129!=====================================================================
130! DECLARATIONS FOR EACH CASE
131!=====================================================================
132!
133      INCLUDE "1D_decl_cases.h"
134!
135!---------------------------------------------------------------------
136!  Declarations related to nudging
137!---------------------------------------------------------------------
138     integer :: nudge_max
139     parameter (nudge_max=9)
140     integer :: inudge_RHT=1
141     integer :: inudge_UV=2
142     logical :: nudge(nudge_max)
143     real :: t_targ(llm)
144     real :: rh_targ(llm)
145     real :: u_targ(llm)
146     real :: v_targ(llm)
147!
148!---------------------------------------------------------------------
149!  Declarations related to vertical discretization:
150!---------------------------------------------------------------------
151      real :: pzero=1.e5
152      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
153      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1)
154
155!---------------------------------------------------------------------
156!  Declarations related to variables
157!---------------------------------------------------------------------
158
159      real :: phi(llm)
160      real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
161      REAL rot(1, llm) ! relative vorticity, in s-1
162      real :: rlat_rad(1),rlon_rad(1)
163      real :: omega(llm),omega2(llm),rho(llm+1)
164      real :: ug(llm),vg(llm),fcoriolis
165      real :: sfdt, cfdt
166      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
167      real :: w_adv(llm),z_adv(llm)
168      real :: d_t_vert_adv(llm),d_u_vert_adv(llm),d_v_vert_adv(llm)
169      real :: dt_cooling(llm),d_t_adv(llm),d_t_nudge(llm)
170      real :: d_u_nudge(llm),d_v_nudge(llm)
171!      real :: d_u_adv(llm),d_v_adv(llm)
172      real :: d_u_age(llm),d_v_age(llm)
173      real :: alpha
174      real :: ttt
175
176      REAL, ALLOCATABLE, DIMENSION(:,:):: q
177      REAL, ALLOCATABLE, DIMENSION(:,:):: dq
178      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_vert_adv
179      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
180      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_nudge
181!      REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
182
183!---------------------------------------------------------------------
184!  Initialization of surface variables
185!---------------------------------------------------------------------
186      real :: run_off_lic_0(1)
187      real :: fder(1),snsrf(1,nbsrf),qsurfsrf(1,nbsrf)
188      real :: tsoil(1,nsoilmx,nbsrf)
189!     real :: agesno(1,nbsrf)
190
191!---------------------------------------------------------------------
192!  Call to phyredem
193!---------------------------------------------------------------------
194      logical :: ok_writedem =.true.
195      real :: sollw_in = 0.
196      real :: solsw_in = 0.
197     
198!---------------------------------------------------------------------
199!  Call to physiq
200!---------------------------------------------------------------------
201      logical :: firstcall=.true.
202      logical :: lastcall=.false.
203      real :: phis(1)    = 0.0
204      real :: dpsrf(1)
205
206!---------------------------------------------------------------------
207!  Initializations of boundary conditions
208!---------------------------------------------------------------------
209      real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
210      real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
211      real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
212      real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
213      real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
214      real, allocatable :: phy_ice (:) ! Fraction de glace
215      real, allocatable :: phy_fter(:) ! Fraction de terre
216      real, allocatable :: phy_foce(:) ! Fraction de ocean
217      real, allocatable :: phy_fsic(:) ! Fraction de glace
218      real, allocatable :: phy_flic(:) ! Fraction de glace
219
220!---------------------------------------------------------------------
221!  Fichiers et d'autres variables
222!---------------------------------------------------------------------
223      integer :: k,l,i,it=1,mxcalc
224      integer :: nsrf
225      integer jcode
226      INTEGER read_climoz
227!
228      integer :: it_end ! iteration number of the last call
229!Al1,plev,play,phi,phis,presnivs,
230      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
231      data ecrit_slab_oc/-1/
232!
233!     if flag_inhib_forcing = 0, tendencies of forcing are added
234!                           <> 0, tendencies of forcing are not added
235      INTEGER :: flag_inhib_forcing = 0
236
237
238      print*,'VOUS ENTREZ DANS LE 1D FORMAT STANDARD'
239
240!=====================================================================
241! INITIALIZATIONS
242!=====================================================================
243      du_phys(:)=0.
244      dv_phys(:)=0.
245      dt_phys(:)=0.
246      d_t_vert_adv(:)=0.
247      d_u_vert_adv(:)=0.
248      d_v_vert_adv(:)=0.
249      dt_cooling(:)=0.
250      d_t_adv(:)=0.
251      d_t_nudge(:)=0.
252      d_u_nudge(:)=0.
253      d_v_nudge(:)=0.
254      d_u_adv(:)=0.
255      d_v_adv(:)=0.
256      d_u_age(:)=0.
257      d_v_age(:)=0.
258     
259     
260! Initialization of Common turb_forcing
261       dtime_frcg = 0.
262       Turb_fcg_gcssold=.false.
263       hthturb_gcssold = 0.
264       hqturb_gcssold = 0.
265
266
267
268
269!---------------------------------------------------------------------
270! OPTIONS OF THE 1D SIMULATION (lmdz1d.def => unicol.def)
271!---------------------------------------------------------------------
272        call conf_unicol
273!Al1 moves this gcssold var from common fcg_gcssold to
274        Turb_fcg_gcssold = xTurb_fcg_gcssold
275! --------------------------------------------------------------------
276        close(1)
277        write(*,*) 'lmdz1d.def lu => unicol.def'
278
279       forcing_SCM = .true.
280       year_ini_cas=1997
281       ! It is possible that those parameters are run twice.
282       ! A REVOIR : LIRE PEUT ETRE AN MOIS JOUR DIRECETEMENT
283
284
285       call getin('anneeref',year_ini_cas)
286       call getin('dayref',day_deb)
287       mth_ini_cas=1 ! pour le moment on compte depuis le debut de l'annee
288       call getin('time_ini',heure_ini_cas)
289
290      print*,'NATURE DE LA SURFACE ',nat_surf
291!
292! Initialization of the logical switch for nudging
293
294     jcode = iflag_nudge
295     do i = 1,nudge_max
296       nudge(i) = mod(jcode,10) .ge. 1
297       jcode = jcode/10
298     enddo
299!-----------------------------------------------------------------------
300!  Definition of the run
301!-----------------------------------------------------------------------
302
303      call conf_gcm( 99, .TRUE. )
304     
305!-----------------------------------------------------------------------
306      allocate( phy_nat (year_len))  ! 0=ocean libre,1=land,2=glacier,3=banquise
307      phy_nat(:)=0.0
308      allocate( phy_alb (year_len))  ! Albedo land only (old value condsurf_jyg=0.3)
309      allocate( phy_sst (year_len))  ! SST (will not be used; cf read_tsurf1d.F)
310      allocate( phy_bil (year_len))  ! Ne sert que pour les slab_ocean
311      phy_bil(:)=1.0
312      allocate( phy_rug (year_len)) ! Longueur rugosite utilisee sur land only
313      allocate( phy_ice (year_len)) ! Fraction de glace
314      phy_ice(:)=0.0
315      allocate( phy_fter(year_len)) ! Fraction de terre
316      phy_fter(:)=0.0
317      allocate( phy_foce(year_len)) ! Fraction de ocean
318      phy_foce(:)=0.0
319      allocate( phy_fsic(year_len)) ! Fraction de glace
320      phy_fsic(:)=0.0
321      allocate( phy_flic(year_len)) ! Fraction de glace
322      phy_flic(:)=0.0
323
324
325!-----------------------------------------------------------------------
326!   Choix du calendrier
327!   -------------------
328
329!      calend = 'earth_365d'
330      if (calend == 'earth_360d') then
331        call ioconf_calendar('360_day')
332        write(*,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
333      else if (calend == 'earth_365d') then
334        call ioconf_calendar('noleap')
335        write(*,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
336      else if (calend == 'earth_366d') then
337        call ioconf_calendar('all_leap')
338        write(*,*)'CALENDRIER CHOISI: Terrestre bissextile'
339      else if (calend == 'gregorian') then
340        stop 'gregorian calend should not be used by normal user'
341        call ioconf_calendar('gregorian') ! not to be used by normal users
342        write(*,*)'CALENDRIER CHOISI: Gregorien'
343      else
344        write (*,*) 'ERROR : unknown calendar ', calend
345        stop 'calend should be 360d,earth_365d,earth_366d,gregorian'
346      endif
347!-----------------------------------------------------------------------
348!
349!c Date :
350!      La date est supposee donnee sous la forme [annee, numero du jour dans
351!      l annee] ; l heure est donnee dans time_ini, lu dans lmdz1d.def.
352!      On appelle ymds2ju pour convertir [annee, jour] en [jour Julien].
353!      Le numero du jour est dans "day". L heure est traitee separement.
354!      La date complete est dans "daytime" (l'unite est le jour).
355
356
357      if (nday>0) then
358         fnday=nday
359      else
360         fnday=-nday/float(day_step)
361      endif
362      print *,'fnday=',fnday
363!     start_time doit etre en FRACTION DE JOUR
364      start_time=time_ini/24.
365
366      annee_ref = anneeref
367      mois = 1
368      day_ref = dayref
369      heure = 0.
370      itau_dyn = 0
371      itau_phy = 0
372      call ymds2ju(annee_ref,mois,day_ref,heure,day)
373      day_ini = int(day)
374      day_end = day_ini + int(fnday)
375
376! Convert the initial date to Julian day
377      day_ini_cas=day_deb
378      print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas
379      call ymds2ju                                                         &
380     & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600            &
381     & ,day_ju_ini_cas)
382      print*,'time case 2',day_ini_cas,day_ju_ini_cas
383      daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation
384
385! Print out the actual date of the beginning of the simulation :
386      call ju2ymds(daytime,year_print, month_print,day_print,sec_print)
387      print *,' Time of beginning : ',                                      &
388     &        year_print, month_print, day_print, sec_print
389
390!---------------------------------------------------------------------
391! Initialization of dimensions, geometry and initial state
392!---------------------------------------------------------------------
393!     call init_phys_lmdz(1,1,llm,1,(/1/)) ! job now done via iniphysiq
394!     but we still need to initialize dimphy module (klon,klev,etc.)  here.
395      call init_dimphy1D(1,llm)
396      call suphel
397      call init_infotrac
398
399      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
400      allocate(q(llm,nqtot)) ; q(:,:)=0.
401      allocate(dq(llm,nqtot))
402      allocate(d_q_vert_adv(llm,nqtot))
403      allocate(d_q_adv(llm,nqtot))
404      allocate(d_q_nudge(llm,nqtot))
405!      allocate(d_th_adv(llm))
406
407      q(:,:) = 0.
408      dq(:,:) = 0.
409      d_q_vert_adv(:,:) = 0.
410      d_q_adv(:,:) = 0.
411      d_q_nudge(:,:) = 0.
412
413!
414!   No ozone climatology need be read in this pre-initialization
415!          (phys_state_var_init is called again in physiq)
416      read_climoz = 0
417      nsw=6
418
419      call phys_state_var_init(read_climoz)
420
421      if (ngrid.ne.klon) then
422         print*,'stop in inifis'
423         print*,'Probleme de dimensions :'
424         print*,'ngrid = ',ngrid
425         print*,'klon  = ',klon
426         stop
427      endif
428!!!=====================================================================
429!!! Feedback forcing values for Gateaux differentiation (al1)
430!!!=====================================================================
431!!
432      qsol = qsolinp
433      qsurf = fq_sat(tsurf,psurf/100.)
434      beta_aridity(:,:) = beta_surf
435      day1= day_ini
436      time=daytime-day
437      ts_toga(1)=tsurf ! needed by read_tsurf1d.F
438      rho(1)=psurf/(rd*tsurf*(1.+(rv/rd-1.)*qsurf))
439
440!
441!! mpl et jyg le 22/08/2012 :
442!!  pour que les cas a flux de surface imposes marchent
443      IF(.NOT.ok_flux_surf.or.max(abs(wtsurf),abs(wqsurf))>0.) THEN
444       fsens=-wtsurf*rcpd*rho(1)
445       flat=-wqsurf*rlvtt*rho(1)
446       print *,'Flux: ok_flux wtsurf wqsurf',ok_flux_surf,wtsurf,wqsurf
447      ENDIF
448      print*,'Flux sol ',fsens,flat
449
450! Vertical discretization and pressure levels at half and mid levels:
451
452      pa   = 5e4
453!!      preff= 1.01325e5
454      preff = psurf
455      IF (ok_old_disvert) THEN
456        call disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
457        print *,'On utilise disvert0'
458        aps(1:llm)=0.5*(ap(1:llm)+ap(2:llm+1))
459        bps(1:llm)=0.5*(bp(1:llm)+bp(2:llm+1))
460        scaleheight=8.
461        pseudoalt(1:llm)=-scaleheight*log(presnivs(1:llm)/preff)
462      ELSE
463        call disvert()
464        print *,'On utilise disvert'
465!       Nouvelle version disvert permettant d imposer ap,bp (modif L.Guez) MPL 18092012
466!       Dans ce cas, on lit ap,bp dans le fichier hybrid.txt
467      ENDIF
468
469      sig_s=presnivs/preff
470      plev =ap+bp*psurf
471      play = 0.5*(plev(1:llm)+plev(2:llm+1))
472      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles.
473
474      IF (forcing_type .eq. 59) THEN
475! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
476      write(*,*) '***********************'
477      do l = 1, llm
478       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
479       if (trouve_700 .and. play(l).le.70000) then
480         llm700=l
481         print *,'llm700,play=',llm700,play(l)/100.
482         trouve_700= .false.
483       endif
484      enddo
485      write(*,*) '***********************'
486      ENDIF
487
488!
489!=====================================================================
490! EVENTUALLY, READ FORCING DATA :
491!=====================================================================
492
493      INCLUDE "1D_read_forc_cases.h"
494   print*,'A d_t_adv ',d_t_adv(1:20)*86400
495
496      if (forcing_GCM2SCM) then
497        write (*,*) 'forcing_GCM2SCM not yet implemented'
498        stop 'in initialization'
499      endif ! forcing_GCM2SCM
500
501
502!=====================================================================
503! Initialisation de la physique :
504!=====================================================================
505
506!  Rq: conf_phys.F90 lit tous les flags de physiq.def; conf_phys appele depuis physiq.F
507!
508! day_step, iphysiq lus dans gcm.def ci-dessus
509! timestep: calcule ci-dessous from rday et day_step
510! ngrid=1
511! llm: defini dans .../modipsl/modeles/LMDZ4/libf/grid/dimension
512! rday: defini dans suphel.F (86400.)
513! day_ini: lu dans run.def (dayref)
514! rlat_rad,rlon-rad: transformes en radian de rlat,rlon lus dans lmdz1d.def (en degres)
515! airefi,zcufi,zcvfi initialises au debut de ce programme
516! rday,ra,rg,rd,rcpd declares dans YOMCST.h et calcules dans suphel.F
517
518
519      day_step = float(nsplit_phys)*day_step/float(iphysiq)
520      write (*,*) 'Time step divided by nsplit_phys (=',nsplit_phys,')'
521      timestep =rday/day_step
522      dtime_frcg = timestep
523!
524      zcufi=airefi
525      zcvfi=airefi
526!
527      rlat_rad(1)=xlat*rpi/180.
528      rlon_rad(1)=xlon*rpi/180.
529
530     ! iniphysiq will call iniaqua who needs year_len from phys_cal_mod
531     year_len_phys_cal_mod=year_len
532           
533     ! Ehouarn: iniphysiq requires arrays related to (3D) dynamics grid,
534     ! e.g. for cell boundaries, which are meaningless in 1D; so pad these
535     ! with '0.' when necessary
536
537      call iniphysiq(iim,jjm,llm, &
538           1,comm_lmdz, &
539           rday,day_ini,timestep,  &
540           (/rlat_rad(1),0./),(/0./), &
541           (/0.,0./),(/rlon_rad(1),0./),  &
542           (/ (/airefi,0./),(/0.,0./) /), &
543           (/zcufi,0.,0.,0./), &
544           (/zcvfi,0./), &
545           ra,rg,rd,rcpd,1)
546      print*,'apres iniphysiq'
547
548! 2 PARAMETRES QUI DEVRAIENT ETRE LUS DANS run.def MAIS NE LE SONT PAS ICI:
549      co2_ppm= 330.0
550      solaire=1370.0
551
552! Ecriture du startphy avant le premier appel a la physique.
553! On le met juste avant pour avoir acces a tous les champs
554
555      if (ok_writedem) then
556
557!--------------------------------------------------------------------------
558! pbl_surface_init (called here) and pbl_surface_final (called by phyredem)
559! need : qsol fder snow qsurf evap rugos agesno ftsoil
560!--------------------------------------------------------------------------
561
562        type_ocean = "force"
563        run_off_lic_0(1) = restart_runoff
564        call fonte_neige_init(run_off_lic_0)
565
566        fder=0.
567        snsrf(1,:)=snowmass ! masse de neige des sous surface
568        qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
569        fevap=0.
570        z0m(1,:)=rugos     ! couverture de neige des sous surface
571        z0h(1,:)=rugosh    ! couverture de neige des sous surface
572        agesno  = xagesno
573        tsoil(:,:,:)=tsurf
574!------ AMMA 2e run avec modele sol et rayonnement actif (MPL 23052012)
575!       tsoil(1,1,1)=299.18
576!       tsoil(1,2,1)=300.08
577!       tsoil(1,3,1)=301.88
578!       tsoil(1,4,1)=305.48
579!       tsoil(1,5,1)=308.00
580!       tsoil(1,6,1)=308.00
581!       tsoil(1,7,1)=308.00
582!       tsoil(1,8,1)=308.00
583!       tsoil(1,9,1)=308.00
584!       tsoil(1,10,1)=308.00
585!       tsoil(1,11,1)=308.00
586!-----------------------------------------------------------------------
587        call pbl_surface_init(fder, snsrf, qsurfsrf, tsoil)
588
589!------------------ prepare limit conditions for limit.nc -----------------
590!--   Ocean force
591
592        print*,'avant phyredem'
593        pctsrf(1,:)=0.
594          if (nat_surf.eq.0.) then
595          pctsrf(1,is_oce)=1.
596          pctsrf(1,is_ter)=0.
597          pctsrf(1,is_lic)=0.
598          pctsrf(1,is_sic)=0.
599        else if (nat_surf .eq. 1) then
600          pctsrf(1,is_oce)=0.
601          pctsrf(1,is_ter)=1.
602          pctsrf(1,is_lic)=0.
603          pctsrf(1,is_sic)=0.
604        else if (nat_surf .eq. 2) then
605          pctsrf(1,is_oce)=0.
606          pctsrf(1,is_ter)=0.
607          pctsrf(1,is_lic)=1.
608          pctsrf(1,is_sic)=0.
609        else if (nat_surf .eq. 3) then
610          pctsrf(1,is_oce)=0.
611          pctsrf(1,is_ter)=0.
612          pctsrf(1,is_lic)=0.
613          pctsrf(1,is_sic)=1.
614
615     end if
616
617
618        print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf         &
619     &        ,pctsrf(1,is_oce),pctsrf(1,is_ter)
620
621        zmasq=pctsrf(1,is_ter)+pctsrf(1,is_lic)
622        zpic = zpicinp
623        ftsol=tsurf
624        falb_dir=albedo
625        falb_dif=albedo
626        rugoro=rugos
627        t_ancien(1,:)=temp(:)
628        q_ancien(1,:)=q(:,1)
629        ql_ancien = 0.
630        qs_ancien = 0.
631        prlw_ancien = 0.
632        prsw_ancien = 0.
633        prw_ancien = 0.
634        IF ( ok_bs ) THEN
635           qbs_ancien = 0.
636           prbsw_ancien = 0.
637        ENDIF
638        IF ( ok_ice_supersat ) THEN
639          cf_ancien = 0.
640          rvc_ancien = 0.
641        ENDIF
642!jyg<
643! Etienne: comment those lines since now the TKE is inialized in 1D_read_forc_cases
644!!      pbl_tke(:,:,:)=1.e-8
645!        pbl_tke(:,:,:)=0.
646!        pbl_tke(:,2,:)=1.e-2
647!>jyg
648        rain_fall=0.
649        snow_fall=0.
650        solsw=0.
651        solswfdiff=0.
652        sollw=0.
653        sollwdown=rsigma*tsurf**4
654        radsol=0.
655        rnebcon=0.
656        ratqs=0.
657        clwcon=0.
658        zmax0 = 0.
659        zmea=zsurf
660        zstd=0.
661        zsig=0.
662        zgam=0.
663        zval=0.
664        zthe=0.
665        sig1=0.
666        w01=0.
667!
668        wake_deltaq = 0.
669        wake_deltat = 0.
670        wake_delta_pbl_TKE(:,:,:) = 0.
671        delta_tsurf = 0.
672        wake_fip = 0.
673        wake_pe = 0.
674        wake_s = 0.
675        awake_s = 0.
676        wake_dens = 0.
677        awake_dens = 0.
678        cv_gen = 0.
679        wake_cstar = 0.
680        ale_bl = 0.
681        ale_bl_trig = 0.
682        alp_bl = 0.
683        IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
684        IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
685        entr_therm = 0.
686        detr_therm = 0.
687        f0 = 0.
688        fm_therm = 0.
689        u_ancien(1,:)=u(:)
690        v_ancien(1,:)=v(:)
691 
692        u10m=0.
693        v10m=0.
694        ale_wake=0.
695        ale_bl_stat=0.
696        ratqs_inter_(:,:)= 0.002
697
698!------------------------------------------------------------------------
699! Make file containing restart for the physics (startphy.nc)
700!
701! NB: List of the variables to be written by phyredem (via put_field):
702! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
703! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
704! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
705! radsol,solsw,solswfdiff,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
706! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
707! t_ancien,q_ancien,,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
708! run_off_lic_0,pbl_tke(:,1:klev,nsrf), zmax0,f0,sig1,w01
709! wake_deltat,wake_deltaq,wake_s,awake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
710! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
711!
712! NB2: The content of the startphy.nc file depends on some flags defined in
713! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have
714! to be set at some arbitratry convenient values.
715!------------------------------------------------------------------------
716!Al1 =============== restart option ======================================
717        iflag_physiq=0
718        call getin('iflag_physiq',iflag_physiq)
719
720        if (.not.restart) then
721          iflag_pbl = 5
722          call phyredem ("startphy.nc")
723        else
724! (desallocations)
725        print*,'callin surf final'
726          call pbl_surface_final( fder, snsrf, qsurfsrf, tsoil)
727        print*,'after surf final'
728          CALL fonte_neige_final(run_off_lic_0)
729        endif
730
731        ok_writedem=.false.
732        print*,'apres phyredem'
733
734      endif ! ok_writedem
735     
736!------------------------------------------------------------------------
737! Make file containing boundary conditions (limit.nc) **Al1->restartdyn***
738! --------------------------------------------------
739! NB: List of the variables to be written in limit.nc
740!     (by writelim.F, subroutine of 1DUTILS.h):
741!        phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
742!        phy_fter,phy_foce,phy_flic,phy_fsic)
743!------------------------------------------------------------------------
744      do i=1,year_len
745        phy_nat(i)  = nat_surf
746        phy_alb(i)  = albedo
747        phy_sst(i)  = tsurf ! read_tsurf1d will be used instead
748        phy_rug(i)  = rugos
749        phy_fter(i) = pctsrf(1,is_ter)
750        phy_foce(i) = pctsrf(1,is_oce)
751        phy_fsic(i) = pctsrf(1,is_sic)
752        phy_flic(i) = pctsrf(1,is_lic)
753      enddo
754
755! fabrication de limit.nc
756      call writelim (1,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,             &
757     &               phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic)
758
759
760      call phys_state_var_end
761!Al1
762      if (restart) then
763        print*,'call to restart dyn 1d'
764        Call dyn1deta0("start1dyn.nc",plev,play,phi,phis,presnivs,          &
765     &              u,v,temp,q,omega2)
766
767       print*,'fnday,annee_ref,day_ref,day_ini',                            &
768     &     fnday,annee_ref,day_ref,day_ini
769!**      call ymds2ju(annee_ref,mois,day_ini,heure,day)
770       day = day_ini
771       day_end = day_ini + nday
772       daytime = day + time_ini/24. ! 1st day and initial time of the simulation
773
774! Print out the actual date of the beginning of the simulation :
775       call ju2ymds(daytime, an, mois, jour, heure)
776       print *,' Time of beginning : y m d h',an, mois,jour,heure/3600.
777
778       day = int(daytime)
779       time=daytime-day
780 
781       print*,'****** intialised fields from restart1dyn *******'
782       print*,'plev,play,phi,phis,presnivs,u,v,temp,q,omega2'
783       print*,'temp(1),q(1,1),u(1),v(1),plev(1),phis :'
784       print*,temp(1),q(1,1),u(1),v(1),plev(1),phis(1)
785! raz for safety
786       do l=1,llm
787         d_q_vert_adv(l,1) = 0.
788       enddo
789      endif
790!======================  end restart =================================
791      IF (ecrit_slab_oc.eq.1) then
792         open(97,file='div_slab.dat',STATUS='UNKNOWN')
793       elseif (ecrit_slab_oc.eq.0) then
794         open(97,file='div_slab.dat',STATUS='OLD')
795       endif
796!
797!=====================================================================
798IF (CPPKEY_OUTPUTPHYSSCM) THEN
799       CALL iophys_ini(timestep)
800END IF
801
802!=====================================================================
803! START OF THE TEMPORAL LOOP :
804!=====================================================================
805           
806      it_end = nint(fnday*day_step)
807      do while(it.le.it_end)
808
809       if (prt_level.ge.1) then
810         print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',                       &
811     &             it,day,time,it_end,day_step
812         print*,'PAS DE TEMPS ',timestep
813       endif
814       if (it.eq.it_end) lastcall=.True.
815
816!---------------------------------------------------------------------
817! Interpolation of forcings in time and onto model levels
818!---------------------------------------------------------------------
819
820      INCLUDE "1D_interp_cases.h"
821
822!---------------------------------------------------------------------
823!  Geopotential :
824!---------------------------------------------------------------------
825        phis(1)=zsurf*RG
826!        phi(1)=phis(1)+RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
827
828        ! Calculate geopotential from the ground surface since phi and phis are added in physiq_mod
829        phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
830
831        do l = 1, llm-1
832          phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*                           &
833     &    (play(l)-play(l+1))/(play(l)+play(l+1))
834        enddo
835
836!---------------------------------------------------------------------
837!  Vertical advection
838!---------------------------------------------------------------------
839
840   IF ( forc_w+forc_omega > 0 ) THEN
841
842      IF ( forc_w == 1 ) THEN
843         w_adv=w_mod_cas
844         z_adv=phi/RG
845      ELSE
846         w_adv=omega
847         z_adv=play
848      ENDIF
849
850      teta=temp*(pzero/play)**rkappa
851      do l=2,llm-1
852        ! vertical tendencies computed as d X / d t = -W  d X / d z
853        d_u_vert_adv(l)=-w_adv(l)*(u(l+1)-u(l-1))/(z_adv(l+1)-z_adv(l-1))
854        d_v_vert_adv(l)=-w_adv(l)*(v(l+1)-v(l-1))/(z_adv(l+1)-z_adv(l-1))
855        ! d theta / dt = -W d theta / d z, transformed into d temp / d t dividing by (pzero/play(l))**rkappa
856        d_t_vert_adv(l)=-w_adv(l)*(teta(l+1)-teta(l-1))/(z_adv(l+1)-z_adv(l-1)) / (pzero/play(l))**rkappa
857        d_q_vert_adv(l,1)=-w_adv(l)*(q(l+1,1)-q(l-1,1))/(z_adv(l+1)-z_adv(l-1))
858      enddo
859      d_u_adv(:)=d_u_adv(:)+d_u_vert_adv(:)
860      d_v_adv(:)=d_v_adv(:)+d_v_vert_adv(:)
861      d_t_adv(:)=d_t_adv(:)+d_t_vert_adv(:)
862      d_q_adv(:,1)=d_q_adv(:,1)+d_q_vert_adv(:,1)
863   
864   ENDIF
865
866!---------------------------------------------------------------------
867! Listing output for debug prt_level>=1
868!---------------------------------------------------------------------
869       if (prt_level>=1) then
870         print *,' avant physiq : -------- day time ',day,time
871         write(*,*) 'firstcall,lastcall,phis',                               &
872     &               firstcall,lastcall,phis
873       end if
874       if (prt_level>=5) then
875         write(*,'(a10,2a4,4a13)') 'BEFOR1 IT=','it','l',                   &
876     &        'presniv','plev','play','phi'
877         write(*,'(a10,2i4,4f13.2)') ('BEFOR1 IT= ',it,l,                   &
878     &         presnivs(l),plev(l),play(l),phi(l),l=1,llm)
879         write(*,'(a11,2a4,a11,6a8)') 'BEFOR2','it','l',                    &
880     &         'presniv','u','v','temp','q1','q2','omega2'
881         write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ',it,l,         &
882     &   presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
883       endif
884
885!---------------------------------------------------------------------
886!   Call physiq :
887!---------------------------------------------------------------------
888       call physiq(ngrid,llm, &
889                    firstcall,lastcall,timestep, &
890                    plev,play,phi,phis,presnivs, &
891                    u,v, rot, temp,q,omega2, &
892                    du_phys,dv_phys,dt_phys,dq,dpsrf)
893                firstcall=.false.
894
895!---------------------------------------------------------------------
896! Listing output for debug
897!---------------------------------------------------------------------
898        if (prt_level>=5) then
899          write(*,'(a11,2a4,4a13)') 'AFTER1 IT=','it','l',                  &
900     &        'presniv','plev','play','phi'
901          write(*,'(a11,2i4,4f13.2)') ('AFTER1 it= ',it,l,                  &
902     &    presnivs(l),plev(l),play(l),phi(l),l=1,llm)
903          write(*,'(a11,2a4,a11,6a8)') 'AFTER2','it','l',                   &
904     &         'presniv','u','v','temp','q1','q2','omega2'
905          write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ',it,l,       &
906     &    presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
907          write(*,'(a11,2a4,a11,5a8)') 'AFTER3','it','l',                   &
908     &         'presniv','du_phys','dv_phys','dt_phys','dq1','dq2'   
909           write(*,'(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ',it,l,            &
910     &      presnivs(l),86400*du_phys(l),86400*dv_phys(l),                   &
911     &       86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm)
912          write(*,*) 'dpsrf',dpsrf
913        endif
914!---------------------------------------------------------------------
915!   Add physical tendencies :
916!---------------------------------------------------------------------
917
918       fcoriolis=2.*sin(rpi*xlat/180.)*romega
919
920      IF (prt_level >= 5) print*, 'fcoriolis, xlat,mxcalc ', &
921                                   fcoriolis, xlat,mxcalc
922
923!---------------------------------------------------------------------
924! Geostrophic forcing
925!---------------------------------------------------------------------
926
927      IF ( forc_geo == 0 ) THEN
928              d_u_age(1:mxcalc)=0.
929              d_v_age(1:mxcalc)=0.
930      ELSE
931       sfdt = sin(0.5*fcoriolis*timestep)
932       cfdt = cos(0.5*fcoriolis*timestep)
933
934        d_u_age(1:mxcalc)= -2.*sfdt/timestep*                                &
935     &          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -                          &
936     &           cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
937!!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
938!
939       d_v_age(1:mxcalc)= -2.*sfdt/timestep*                                 &
940     &          (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +                           &
941     &           sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
942!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
943      ENDIF
944!
945!---------------------------------------------------------------------
946!  Nudging
947!  EV: rewrite the section to account for a time- and height-varying
948!  nudging
949!---------------------------------------------------------------------
950      d_t_nudge(:) = 0.
951      d_u_nudge(:) = 0.
952      d_v_nudge(:) = 0.
953      d_q_nudge(:,:) = 0.
954
955      DO l=1,llm
956
957         IF (nudging_u .LT. 0) THEN
958             
959             d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))*invtau_u_nudg_mod_cas(l)
960       
961         ELSE
962
963             IF ( play(l) < p_nudging_u .AND. nint(nudging_u) /= 0 ) &
964             & d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))/nudging_u
965
966         ENDIF
967
968
969         IF (nudging_v .LT. 0) THEN
970             
971             d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))*invtau_v_nudg_mod_cas(l)
972       
973         ELSE
974
975
976             IF ( play(l) < p_nudging_v .AND. nint(nudging_v) /= 0 ) &
977             & d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))/nudging_v
978
979         ENDIF
980
981
982         IF (nudging_t .LT. 0) THEN
983             
984             d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))*invtau_temp_nudg_mod_cas(l)
985       
986         ELSE
987
988
989             IF ( play(l) < p_nudging_t .AND. nint(nudging_t) /= 0 ) &
990             & d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))/nudging_t
991
992          ENDIF
993
994
995         IF (nudging_qv .LT. 0) THEN
996             
997             d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))*invtau_qv_nudg_mod_cas(l)
998       
999         ELSE
1000
1001             IF ( play(l) < p_nudging_qv .AND. nint(nudging_qv) /= 0 ) &
1002             & d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))/nudging_qv
1003
1004         ENDIF
1005
1006      ENDDO
1007
1008!---------------------------------------------------------------------
1009!  Optional outputs
1010!---------------------------------------------------------------------
1011
1012IF (CPPKEY_OUTPUTPHYSSCM) THEN
1013      CALL iophys_ecrit('w_adv',klev,'w_adv','K/day',w_adv)
1014      CALL iophys_ecrit('z_adv',klev,'z_adv','K/day',z_adv)
1015      CALL iophys_ecrit('dtadv',klev,'dtadv','K/day',86400*d_t_adv)
1016      CALL iophys_ecrit('dtdyn',klev,'dtdyn','K/day',86400*d_t_vert_adv)
1017      CALL iophys_ecrit('qv',klev,'qv','g/kg',1000*q(:,1))
1018      CALL iophys_ecrit('qvnud',klev,'qvnud','g/kg',1000*u_nudg_mod_cas)
1019      CALL iophys_ecrit('u',klev,'u','m/s',u)
1020      CALL iophys_ecrit('unud',klev,'unud','m/s',u_nudg_mod_cas)
1021      CALL iophys_ecrit('v',klev,'v','m/s',v)
1022      CALL iophys_ecrit('vnud',klev,'vnud','m/s',v_nudg_mod_cas)
1023      CALL iophys_ecrit('temp',klev,'temp','K',temp)
1024      CALL iophys_ecrit('tempnud',klev,'temp_nudg_mod_cas','K',temp_nudg_mod_cas)
1025      CALL iophys_ecrit('dtnud',klev,'dtnud','K/day',86400*d_t_nudge)
1026      CALL iophys_ecrit('dqnud',klev,'dqnud','K/day',1000*86400*d_q_nudge(:,1))
1027END IF
1028
1029    IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
1030
1031        u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
1032     &              du_phys(1:mxcalc)                                       &
1033     &             +d_u_age(1:mxcalc)+d_u_adv(1:mxcalc)                       &
1034     &             +d_u_nudge(1:mxcalc) )           
1035        v(1:mxcalc)=v(1:mxcalc) + timestep*(                                 &
1036     &              dv_phys(1:mxcalc)                                       &
1037     &             +d_v_age(1:mxcalc)+d_v_adv(1:mxcalc)                       &
1038     &             +d_v_nudge(1:mxcalc) )
1039        q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(                              &
1040     &                dq(1:mxcalc,:)                                        &
1041     &               +d_q_adv(1:mxcalc,:)                                   &
1042     &               +d_q_nudge(1:mxcalc,:) )
1043
1044        if (prt_level.ge.3) then
1045          print *,                                                          &
1046     &    'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ',         &
1047     &              temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1)
1048           print* ,'dv_phys=',dv_phys
1049           print* ,'d_v_age=',d_v_age
1050           print* ,'d_v_adv=',d_v_adv
1051           print* ,'d_v_nudge=',d_v_nudge
1052           print*, v
1053           print*, vg
1054        endif
1055
1056        temp(1:mxcalc)=temp(1:mxcalc)+timestep*(                            &
1057     &              dt_phys(1:mxcalc)                                       &
1058     &             +d_t_adv(1:mxcalc)                                       &
1059     &             +d_t_nudge(1:mxcalc)                                     &
1060     &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
1061
1062
1063!=======================================================================
1064!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
1065!=======================================================================
1066
1067        teta=temp*(pzero/play)**rkappa
1068
1069!---------------------------------------------------------------------
1070!   Nudge soil temperature if requested
1071!---------------------------------------------------------------------
1072
1073      IF (nudge_tsoil .AND. .NOT. lastcall) THEN
1074       ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:)                     &
1075     &  -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)
1076      ENDIF
1077
1078!---------------------------------------------------------------------
1079!   Add large-scale tendencies (advection, etc) :
1080!---------------------------------------------------------------------
1081
1082!cc nrlmd
1083!cc        tmpvar=teta
1084!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
1085!cc
1086!cc        teta(1:mxcalc)=tmpvar(1:mxcalc)
1087!cc        tmpvar(:)=q(:,1)
1088!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
1089!cc        q(1:mxcalc,1)=tmpvar(1:mxcalc)
1090!cc        tmpvar(:)=q(:,2)
1091!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
1092!cc        q(1:mxcalc,2)=tmpvar(1:mxcalc)
1093
1094   END IF ! end if tendency of tendency should be added
1095
1096!---------------------------------------------------------------------
1097!   Air temperature :
1098!---------------------------------------------------------------------       
1099        if (lastcall) then
1100          print*,'Pas de temps final ',it
1101          call ju2ymds(daytime, an, mois, jour, heure)
1102          print*,'a la date : a m j h',an, mois, jour ,heure/3600.
1103        endif
1104
1105!  incremente day time
1106        daytime = daytime+1./day_step
1107        day = int(daytime+0.1/day_step)
1108!        time = max(daytime-day,0.0)
1109!Al1&jyg: correction de bug
1110!cc        time = real(mod(it,day_step))/day_step
1111        time = time_ini/24.+real(mod(it,day_step))/day_step
1112        it=it+1
1113
1114      enddo
1115
1116      if (ecrit_slab_oc.ne.-1) close(97)
1117
1118!Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
1119! ---------------------------------------------------------------------------
1120       call dyn1dredem("restart1dyn.nc",                                    &
1121     &              plev,play,phi,phis,presnivs,                            &
1122     &              u,v,temp,q,omega2)
1123
1124        CALL abort_gcm ('lmdz1d   ','The End  ',0)
1125
1126END SUBROUTINE scm
Note: See TracBrowser for help on using the repository browser.