source: trunk/LMDZ.MARS/libf/phymars/testphys1d.F @ 171

Last change on this file since 171 was 161, checked in by acolaitis, 13 years ago

================================================
======== IMPLEMENTATION OF THERMALS ============
================================================

Author: A. Colaitis (2011-06-16)

The main goal of this revision is to start including the thermals into the model
for development purposes. Users should not use the thermals yet, as
several major configuration changes still need to be done.

This version includes :

  • updraft and downdraft parametrizations
  • velocity in the thermal, including drag
  • plume height analysis
  • closure equation
  • updraft transport of heat, tracers and momentum
  • downdraft transport of heat

This model should not be used without upcoming developments, namely :

  • downdraft transport of tracers and momentum
  • updraft & downdraft transport of q2 (tke)
  • revision of vdif_kc to compute q2 for non-stratified cases

Thermals could also include in a later revision :

  • momentum loss during transport (horizontal drag)

Compilation of the thermals has been successfully tested on ifort, gfortran and pgf90

================================================
================================================

M libf/phymars/callkeys.h
M libf/phymars/inifis.F

Added new control flags to call the thermals :

  • calltherm (false by default) <- to call thermals
  • outptherm (false by default) <- to output thermal-related diagnostics (for dev purposes)

================================================

M libf/phymars/vdifc.F
------> added a temporary output for thermal-related diagnostics

M libf/phymars/testphys1d.F
------> added treatment for a initialization from a profile of neutral gas (ar)

-> will be transformed in a decaying tracer for thermal diagnostics

M libf/phymars/physiq.F
------> added a section to call the thermals

-> changed the call to convadj
-> added thermal-related outputs for diagnostics

M libf/phymars/convadj.F
------> takes now into account the height of thermals to execute convective adjustment

=> note : convective adjustment needs to be activated when using thermals, in case of a

second instable layer above the thermals

================================================

A libf/phymars/calltherm_interface.F90
------> Interface between physiq.F and the thermals

A libf/phymars/calltherm_mars.F90
------> Routine running the sub-timestep of the thermals

A libf/phymars/thermcell_main_mars.F90
------> Main thermals routine specific to Martian physics

A libf/phymars/thermcell_dqupdown.F90
------> Thermals subroutine computing transport of quantities by updrafts and downdrafts

A libf/phymars/thermcell.F90
------> Module including parameters from the Earth to Mars importation. Will disappear in future dev

================================================
================================================

File size: 23.3 KB
Line 
1
2      PROGRAM testphys1d
3! to use  'getin'
4      USE ioipsl_getincom
5      IMPLICIT NONE
6
7c=======================================================================
8c   subject:
9c   --------
10c   PROGRAM useful to run physical part of the martian GCM in a 1D column
11c       
12c Can be compiled with a command like (e.g. for 25 layers)
13c  "makegcm -p mars -d 25 testphys1d"
14c It requires the files "testphys1d.def" "callphys.def"
15c   and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line)
16c      and a file describing the sigma layers (e.g. "z2sig.def")
17c
18c   author: Frederic Hourdin, R.Fournier,F.Forget
19c   -------
20c   
21c   update: 12/06/2003 including chemistry (S. Lebonnois)
22c                            and water ice (F. Montmessin)
23c
24c=======================================================================
25
26#include "dimensions.h"
27#include "dimphys.h"
28#include "dimradmars.h"
29#include "comgeomfi.h"
30#include "surfdat.h"
31#include "comsoil.h"
32#include "comdiurn.h"
33#include "callkeys.h"
34#include "comcstfi.h"
35#include "planete.h"
36#include "comsaison.h"
37#include "yomaer.h"
38#include "control.h"
39#include "comvert.h"
40#include "netcdf.inc"
41#include "comg1d.h"
42#include "watercap.h"
43#include "logic.h"
44#include "advtrac.h"
45
46c --------------------------------------------------------------
47c  Declarations
48c --------------------------------------------------------------
49c
50      INTEGER unitstart      ! unite d'ecriture de "startfi"
51      INTEGER nlayer,nlevel,nsoil,ndt
52      INTEGER ilayer,ilevel,isoil,idt,iq
53      LOGICAl firstcall,lastcall
54c
55      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
56      REAL day           ! date durant le run
57      REAL time             ! time (0<time<1 ; time=0.5 a midi)
58      REAL play(nlayermx)   ! Pressure at the middle of the layers (Pa)
59      REAL plev(nlayermx+1) ! intermediate pressure levels (pa)
60      REAL psurf,tsurf     
61      REAL u(nlayermx),v(nlayermx)  ! zonal, meridional wind
62      REAL gru,grv   ! prescribed "geostrophic" background wind
63      REAL temp(nlayermx)   ! temperature at the middle of the layers
64      REAL q(nlayermx,nqmx) ! tracer mixing ratio (e.g. kg/kg)
65      REAL qsurf(nqmx)      ! tracer surface budget (e.g. kg.m-2)
66      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
67      REAL co2ice           ! co2ice layer (kg.m-2)
68      REAL emis             ! surface layer
69      REAL q2(nlayermx+1)   ! Turbulent Kinetic Energy
70      REAL zlay(nlayermx)   ! altitude estimee dans les couches (km)
71
72c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
73      REAL du(nlayermx),dv(nlayermx),dtemp(nlayermx)
74      REAL dudyn(nlayermx),dvdyn(nlayermx),dtempdyn(nlayermx)
75      REAL dpsurf   
76      REAL dq(nlayermx,nqmx)
77      REAL dqdyn(nlayermx,nqmx)
78
79c   Various intermediate variables
80      INTEGER thermo
81      REAL zls
82      REAL phi(nlayermx),h(nlayermx),s(nlayermx)
83      REAL pks, ptif, w(nlayermx)
84      REAL qtotinit, mqtot(nqmx),qtot
85      INTEGER ierr, aslun
86      REAL tmp1(0:nlayermx),tmp2(0:nlayermx)
87      Logical  tracerdyn
88      integer :: nq=1 ! number of tracers
89
90      character*2 str2
91      character (len=7) :: str7
92      character(len=44) :: txt
93
94c=======================================================================
95
96c=======================================================================
97c INITIALISATION
98c=======================================================================
99
100c ------------------------------------------------------
101c  Constantes prescrites ICI
102c ------------------------------------------------------
103
104      pi=2.E+0*asin(1.E+0)
105
106c     Constante de la Planete Mars
107c     ----------------------------
108      rad=3397200.               ! rayon de mars (m)  ~3397200 m
109      daysec=88775.              ! duree du sol (s)  ~88775 s
110      omeg=4.*asin(1.)/(daysec)  ! vitesse de rotation (rad.s-1)
111      g=3.72                     ! gravite (m.s-2) ~3.72 
112      mugaz=43.49                ! Masse molaire de l'atm (g.mol-1) ~43.49
113      rcp=.256793                ! = r/cp  ~0.256793
114      r= 8.314511E+0 *1000.E+0/mugaz
115      cpp= r/rcp
116      year_day = 669           ! duree de l'annee (sols) ~668.6
117      periheli = 206.66          ! dist.min. soleil-mars (Mkm) ~206.66
118      aphelie = 249.22           ! dist.max. soleil-mars (Mkm) ~249.22
119      peri_day =  485.           ! date du perihelie (sols depuis printemps)
120      obliquit = 25.2           ! Obliquite de la planete (deg) ~25.2         
121 
122c     Parametres Couche limite et Turbulence
123c     --------------------------------------
124      z0 =  1.e-2                ! surface roughness (m) ~0.01
125      emin_turb = 1.e-6          ! energie minimale ~1.e-8
126      lmixmin = 30               ! longueur de melange ~100
127 
128c     propriete optiques des calottes et emissivite du sol
129c     ----------------------------------------------------
130      emissiv= 0.95              ! Emissivite du sol martien ~.95
131      emisice(1)=0.95            ! Emissivite calotte nord
132      emisice(2)=0.95            ! Emissivite calotte sud 
133      albedice(1)=0.5           ! Albedo calotte nord
134      albedice(2)=0.5            ! Albedo calotte sud
135      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
136      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
137      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
138      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
139      hybrid=.false.
140
141c ------------------------------------------------------
142c  Lecture des parametres dans "run.def"
143c ------------------------------------------------------
144
145
146! check if 'run.def' file is around (otherwise reading parameters
147! from callphys.def via getin() routine won't work.
148      open(99,file='run.def',status='old',form='formatted',
149     &     iostat=ierr)
150      if (ierr.ne.0) then
151        write(*,*) 'Cannot find required file "run.def"'
152        write(*,*) '  (which should contain some input parameters'
153        write(*,*) '   along with the following line:'
154        write(*,*) '   INCLUDEDEF=callphys.def'
155        write(*,*) '   )'
156        write(*,*) ' ... might as well stop here ...'
157        stop
158      else
159        close(99)
160      endif
161
162! check if we are going to run with or without tracers
163      write(*,*) "Run with or without tracer transport ?"
164      tracer=.false. ! default value
165      call getin("tracer",tracer)
166      write(*,*) " tracer = ",tracer
167
168! while we're at it, check if there is a 'traceur.def' file
169! and preocess it, if necessary. Otherwise initialize tracer names
170      if (tracer) then
171      ! load tracer names from file 'traceur.def'
172        open(90,file='traceur.def',status='old',form='formatted',
173     &       iostat=ierr)
174        if (ierr.ne.0) then
175          write(*,*) 'Cannot find required file "traceur.def"'
176          write(*,*) ' If you want to run with tracers, I need it'
177          write(*,*) ' ... might as well stop here ...'
178          stop
179        else
180          write(*,*) "testphys1d: Reading file traceur.def"
181          ! read number of tracers:
182          read(90,*,iostat=ierr) nq
183          if (ierr.ne.0) then
184            write(*,*) "testphys1d: error reading number of tracers"
185            write(*,*) "   (first line of traceur.def) "
186            stop
187          else
188            ! check that the number of tracers is indeed nqmx
189            if (nq.ne.nqmx) then
190              write(*,*) "testphys1d: error, wrong number of tracers:"
191              write(*,*) "nq=",nq," whereas nqmx=",nqmx
192              stop
193            endif
194          endif
195        endif
196        ! read tracer names from file traceur.def
197        do iq=1,nqmx
198          read(90,*,iostat=ierr) tnom(iq)
199          if (ierr.ne.0) then
200            write(*,*) 'testphys1d: error reading tracer names...'
201            stop
202          endif
203        enddo
204        close(90)
205
206        ! initialize tracers here:
207        write(*,*) "testphys1d: initializing tracers"
208        q(:,:)=0 ! default, set everything to zero
209        qsurf(:)=0
210        ! "smarter" initialization of some tracers
211        ! (get values from "profile_*" files, if these are available)
212        do iq=1,nqmx
213          txt=""
214          write(txt,"(a)") tnom(iq)
215          write(*,*)"  tracer:",trim(txt)
216          ! CO2
217          if (txt.eq."co2") then
218            q(:,iq)=0.95   ! kg /kg of atmosphere
219            qsurf(iq)=0. ! kg/m2 (not used for CO2)
220            ! even better, look for a "profile_co2" input file
221            open(91,file='profile_co2',status='old',
222     &       form='formatted',iostat=ierr)
223            if (ierr.eq.0) then
224              read(91,*) qsurf(iq)
225              do ilayer=1,nlayermx
226                read(91,*) q(ilayer,iq)
227              enddo
228            endif
229            close(91)
230          endif ! of if (txt.eq."co2")
231          ! Allow for an initial profile of argon
232          ! Can also be used to introduce a decaying tracer
233          ! in the 1D (TBD) to study thermals
234          if (txt.eq."ar") then
235            !look for a "profile_ar" input file
236            open(91,file='profile_ar',status='old',
237     &       form='formatted',iostat=ierr)
238            if (ierr.eq.0) then
239              read(91,*) qsurf(iq)
240              do ilayer=1,nlayermx
241                read(91,*) q(ilayer,iq)
242              enddo
243            else
244              write(*,*) "No profile_ar file!"
245            endif
246            close(91)
247          endif ! of if (txt.eq."ar")
248
249          ! WATER VAPOUR
250          if (txt.eq."h2o_vap") then
251            !look for a "profile_h2o_vap" input file
252            open(91,file='profile_h2o_vap',status='old',
253     &       form='formatted',iostat=ierr)
254            if (ierr.eq.0) then
255              read(91,*) qsurf(iq)
256              do ilayer=1,nlayermx
257                read(91,*) q(ilayer,iq)
258              enddo
259            else
260              write(*,*) "No profile_h2o_vap file!"
261            endif
262            close(91)
263          endif ! of if (txt.eq."h2o_ice")
264          ! WATER ICE
265          if (txt.eq."h2o_ice") then
266            !look for a "profile_h2o_vap" input file
267            open(91,file='profile_h2o_ice',status='old',
268     &       form='formatted',iostat=ierr)
269            if (ierr.eq.0) then
270              read(91,*) qsurf(iq)
271              do ilayer=1,nlayermx
272                read(91,*) q(ilayer,iq)
273              enddo
274            else
275              write(*,*) "No profile_h2o_ice file!"
276            endif
277            close(91)
278          endif ! of if (txt.eq."h2o_ice")
279          ! DUST
280          !if (txt(1:4).eq."dust") then
281          !  q(:,iq)=0.4    ! kg/kg of atmosphere
282          !  qsurf(iq)=100 ! kg/m2
283          !endif
284          ! DUST MMR
285          if (txt.eq."dust_mass") then
286            !look for a "profile_dust_mass" input file
287            open(91,file='profile_dust_mass',status='old',
288     &       form='formatted',iostat=ierr)
289            if (ierr.eq.0) then
290              read(91,*) qsurf(iq)
291              do ilayer=1,nlayermx
292                read(91,*) q(ilayer,iq)
293!                write(*,*) "l=",ilayer," q(ilayer,iq)=",q(ilayer,iq)
294              enddo
295            else
296              write(*,*) "No profile_dust_mass file!"
297            endif
298            close(91)
299          endif ! of if (txt.eq."dust_mass")
300          ! DUST NUMBER
301          if (txt.eq."dust_number") then
302            !look for a "profile_dust_number" input file
303            open(91,file='profile_dust_number',status='old',
304     &       form='formatted',iostat=ierr)
305            if (ierr.eq.0) then
306              read(91,*) qsurf(iq)
307              do ilayer=1,nlayermx
308                read(91,*) q(ilayer,iq)
309              enddo
310            else
311              write(*,*) "No profile_dust_number file!"
312            endif
313            close(91)
314          endif ! of if (txt.eq."dust_number")
315        enddo ! of do iq=1,nqmx
316        ! NB: some more initializations (chemistry) is done later
317
318      else
319      ! we still need to set (dummy) tracer names for physdem1
320        nq=nqmx
321        do iq=1,nq
322          write(str7,'(a1,i2.2)')'q',iq
323          tnom(iq)=str7
324        enddo
325      endif ! of if (tracer)
326
327c  Date et heure locale du debut du run
328c  ------------------------------------
329c    Date (en sols depuis le solstice de printemps) du debut du run
330      day0 = 0 ! default value for day0
331      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
332      call getin("day0",day0)
333      day=float(day0)
334      write(*,*) " day0 = ",day0
335c  Heure de demarrage
336      time=0 ! default value for time
337      write(*,*)'Initial local time (in hours, between 0 and 24)?'
338      call getin("time",time)
339      write(*,*)" time = ",time
340      time=time/24.E+0 ! convert time (hours) to fraction of sol
341
342c  Discretisation (Definition de la grille et des pas de temps)
343c  --------------
344c
345      nlayer=nlayermx
346      nlevel=nlayer+1
347      nsoil=nsoilmx
348
349      day_step=48 ! default value for day_step
350      PRINT *,'Number of time steps per sol ?'
351      call getin("day_step",day_step)
352      write(*,*) " day_step = ",day_step
353
354      ndt=10 ! default value for ndt
355      PRINT *,'Number of sols to run ?'
356      call getin("ndt",ndt)
357      write(*,*) " ndt = ",ndt
358
359      ndt=ndt*day_step     
360      dtphys=daysec/day_step 
361c Pression de surface sur la planete
362c ------------------------------------
363c
364      psurf=610. ! default value for psurf
365      PRINT *,'Surface pressure (Pa) ?'
366      call getin("psurf",psurf)
367      write(*,*) " psurf = ",psurf
368c Pression de reference
369      pa=20.
370      preff=610.     
371 
372c Proprietes des poussiere aerosol
373c --------------------------------
374      tauvis=0.2 ! default value for tauvis
375      print *,'Reference dust opacity at 700 Pa ?'
376      call getin("tauvis",tauvis)
377      write(*,*) " tauvis = ",tauvis
378 
379c  latitude/longitude
380c  ------------------
381      lati(1)=0 ! default value for lati(1)
382      PRINT *,'latitude (in degrees) ?'
383      call getin("latitude",lati(1))
384      write(*,*) " latitude = ",lati(1)
385      lati(1)=lati(1)*pi/180.E+0
386      long(1)=0.E+0
387      long(1)=long(1)*pi/180.E+0
388
389c  Initialisation albedo / inertie du sol
390c  --------------------------------------
391c
392      albedodat(1)=0.2 ! default value for albedodat
393      PRINT *,'Albedo of bare ground ?'
394      call getin("albedo",albedodat(1))
395      write(*,*) " albedo = ",albedodat(1)
396
397      inertiedat(1,1)=400 ! default value for inertiedat
398      PRINT *,'Soil thermal inertia (SI) ?'
399      call getin("inertia",inertiedat(1,1))
400      write(*,*) " inertia = ",inertiedat(1,1)
401c
402c  pour le schema d'ondes de gravite
403c  ---------------------------------
404c
405      zmea(1)=0.E+0
406      zstd(1)=0.E+0
407      zsig(1)=0.E+0
408      zgam(1)=0.E+0
409      zthe(1)=0.E+0
410
411
412
413c   Initialisation speciales "physiq"
414c   ---------------------------------
415c   la surface de chaque maille est inutile en 1D --->
416      area(1)=1.E+0
417
418c   le geopotentiel au sol est inutile en 1D car tout est controle
419c   par la pression de surface --->
420      phisfi(1)=0.E+0
421
422c  "inifis" reproduit un certain nombre d'initialisations deja faites
423c  + lecture des clefs de callphys.def
424c  + calcul de la frequence d'appel au rayonnement
425c  + calcul des sinus et cosinus des longitude latitude
426
427!Mars possible matter with dtphys in input and include!!!
428#ifdef MESOSCALE
429      CALL meso_inifis(1,llm,day0,daysec,dtphys,
430#else
431      CALL inifis(1,llm,day0,daysec,dtphys,
432#endif
433     .            lati,long,area,rad,g,r,cpp)
434c   Initialisation pour prendre en compte les vents en 1-D
435c   ------------------------------------------------------
436      ptif=2.E+0*omeg*sinlat(1)
437 
438c    vent geostrophique
439      gru=10. ! default value for gru
440      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
441      call getin("u",gru)
442      write(*,*) " u = ",gru
443      grv=0. !default value for grv
444      PRINT *,'meridional northward component of the geostrophic',
445     &' wind (m/s) ?'
446      call getin("v",grv)
447      write(*,*) " v = ",grv
448
449c     Initialisation des vents  au premier pas de temps
450      DO ilayer=1,nlayer
451         u(ilayer)=gru
452         v(ilayer)=grv
453      ENDDO
454
455c     energie cinetique turbulente
456      DO ilevel=1,nlevel
457         q2(ilevel)=0.E+0
458      ENDDO
459
460c  glace de CO2 au sol
461c  -------------------
462      co2ice=0.E+0 ! default value for co2ice
463      PRINT *,'Initial CO2 ice on the surface (kg.m-2)'
464      call getin("co2ice",co2ice)
465      write(*,*) " co2ice = ",co2ice
466
467c
468c  emissivite
469c  ----------
470      emis=emissiv
471      IF (co2ice.eq.1.E+0) THEN
472         emis=emisice(1) ! northern hemisphere
473         IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
474      ENDIF
475
476 
477
478c  calcul des pressions et altitudes en utilisant les niveaux sigma
479c  ----------------------------------------------------------------
480
481c    Vertical Coordinates
482c    """"""""""""""""""""
483      hybrid=.true.
484      PRINT *,'Hybrid coordinates ?'
485      call getin("hybrid",hybrid)
486      write(*,*) " hybrid = ", hybrid
487
488      CALL  disvert
489
490      DO ilevel=1,nlevel
491        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
492      ENDDO
493
494      DO ilayer=1,nlayer
495        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
496      ENDDO
497
498      DO ilayer=1,nlayer
499        zlay(ilayer)=-200.E+0 *r*log(play(ilayer)/plev(1))
500     &   /g
501      ENDDO
502
503
504c  profil de temperature au premier appel
505c  --------------------------------------
506      pks=psurf**rcp
507
508c altitude en km dans profile: on divise zlay par 1000
509      tmp1(0)=0.E+0
510      DO ilayer=1,nlayer
511        tmp1(ilayer)=zlay(ilayer)/1000.E+0
512      ENDDO
513
514      call profile(nlayer+1,tmp1,tmp2)
515
516      tsurf=tmp2(0)
517      DO ilayer=1,nlayer
518        temp(ilayer)=tmp2(ilayer)
519      ENDDO
520     
521
522
523! Initialize soil properties and temperature
524! ------------------------------------------
525      volcapa=1.e6 ! volumetric heat capacity
526      DO isoil=1,nsoil
527         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
528         tsoil(isoil)=tsurf  ! soil temperature
529      ENDDO
530
531! Initialize depths
532! -----------------
533      do isoil=0,nsoil-1
534        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
535      enddo
536      do isoil=1,nsoil
537        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
538      enddo
539
540c    Initialisation des traceurs
541c    ---------------------------
542
543      if (photochem.or.callthermos) then
544         write(*,*) 'Especes chimiques initialisees'
545         ! thermo=0: initialisation pour toutes les couches
546         thermo=0
547         call inichim_newstart(q,psurf,sig,nqmx,lati,long,area,
548     $   thermo,qsurf)
549      endif
550      watercaptag(ngridmx)=.false.
551     
552
553c    Initialisation pour les sorties GRADS dans "g1d.dat" et "g1d.ctl"
554c    ----------------------------------------------------------------
555c    (effectuee avec "writeg1d" a partir de "physiq.F"
556c    ou tout autre subroutine physique, y compris celle ci).
557
558        g1d_nlayer=nlayer
559        g1d_nomfich='g1d.dat'
560        g1d_unitfich=40
561        g1d_nomctl='g1d.ctl'
562        g1d_unitctl=41
563        g1d_premier=.true.
564        g2d_premier=.true.
565
566c  Ecriture de "startfi"
567c  --------------------
568c  (Ce fichier sera aussitot relu au premier
569c   appel de "physiq", mais il est necessaire pour passer
570c   les variables purement physiques a "physiq"...
571
572      call physdem1("startfi.nc",long,lati,nsoilmx,nqmx,
573     .              dtphys,float(day0),
574     .              time,tsurf,tsoil,co2ice,emis,q2,qsurf,
575     .              area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
576c=======================================================================
577c  BOUCLE TEMPORELLE DU MODELE 1D
578c=======================================================================
579c
580      firstcall=.true.
581      lastcall=.false.
582
583      DO idt=1,ndt
584c        IF (idt.eq.ndt) lastcall=.true.
585        IF (idt.eq.ndt-day_step-1) then       !test
586         lastcall=.true.
587         call solarlong(day*1.0,zls)
588         write(103,*) 'Ls=',zls*180./pi
589         write(103,*) 'Lat=', lati(1)*180./pi
590         write(103,*) 'Tau=', tauvis/700*psurf
591         write(103,*) 'RunEnd - Atmos. Temp. File'
592         write(103,*) 'RunEnd - Atmos. Temp. File'
593         write(104,*) 'Ls=',zls*180./pi
594         write(104,*) 'Lat=', lati(1)
595         write(104,*) 'Tau=', tauvis/700*psurf
596         write(104,*) 'RunEnd - Atmos. Temp. File'
597        ENDIF
598
599c    calcul du geopotentiel
600c     ~~~~~~~~~~~~~~~~~~~~~
601      DO ilayer=1,nlayer
602        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
603        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
604      ENDDO
605      phi(1)=pks*h(1)*(1.E+0-s(1))
606      DO ilayer=2,nlayer
607         phi(ilayer)=phi(ilayer-1)+
608     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
609     &                  *(s(ilayer-1)-s(ilayer))
610
611      ENDDO
612
613c       appel de la physique
614c       --------------------
615#ifdef MESOSCALE
616      CALL meso_physiq (1,llm,nqmx,
617#else
618      CALL physiq (1,llm,nqmx,
619#endif
620     ,     firstcall,lastcall,
621     ,     day,time,dtphys,
622     ,     plev,play,phi,
623     ,     u, v,temp, q, 
624     ,     w,
625C - sorties
626     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
627
628c       evolution du vent : modele 1D
629c       -----------------------------
630 
631c       la physique calcule les derivees temporelles de u et v.
632c       on y rajoute betement un effet Coriolis.
633c
634c       DO ilayer=1,nlayer
635c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
636c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
637c       ENDDO
638
639c       Pour certain test : pas de coriolis a l'equateur
640c       if(lati(1).eq.0.) then
641          DO ilayer=1,nlayer
642             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
643             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
644          ENDDO
645c       end if
646c     
647c
648c       Calcul du temps au pas de temps suivant
649c       ---------------------------------------
650        firstcall=.false.
651        time=time+dtphys/daysec
652        IF (time.gt.1.E+0) then
653            time=time-1.E+0
654            day=day+1
655        ENDIF
656
657c       calcul des vitesses et temperature au pas de temps suivant
658c       ----------------------------------------------------------
659
660        DO ilayer=1,nlayer
661           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
662           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
663           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
664        ENDDO
665
666c       calcul des pressions au pas de temps suivant
667c       ----------------------------------------------------------
668
669           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
670           DO ilevel=1,nlevel
671             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
672           ENDDO
673           DO ilayer=1,nlayer
674             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
675           ENDDO
676
677!       increment tracer values
678        DO iq = 1, nqmx
679          DO ilayer=1,nlayer
680             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
681          ENDDO
682        ENDDO
683
684      ENDDO   ! fin de la boucle temporelle
685
686c    ========================================================
687c    GESTION DES SORTIE
688c    ========================================================
689
690c    fermeture pour conclure les sorties format grads dans "g1d.dat"
691c    et "g1d.ctl" (effectuee avec "writeg1d" a partir de "physiq.F"
692c    ou tout autre subroutine physique, y compris celle ci).
693
694c        CALL endg1d(1,nlayer,zphi/(g*1000.),ndt)
695        CALL endg1d(1,nlayer,zlay/1000.,ndt)
696
697c    ========================================================
698      END
699 
700c***********************************************************************
701c***********************************************************************
702c     Subroutines Bidons utilise seulement en 3D, mais
703c     necessaire a la compilation de testphys1d en 1-D
704
705      subroutine gr_fi_dyn
706      RETURN
707      END
708 
709c***********************************************************************
710c***********************************************************************
711
712#include "../dyn3d/disvert.F"
Note: See TracBrowser for help on using the repository browser.