source: trunk/LMDZ.MARS/libf/phymars/inifis.F @ 1009

Last change on this file since 1009 was 833, checked in by jbmadeleine, 12 years ago

Mars GCM:

Implemented the thermal inertia feedback:

  • Added a flag in callphys.def called tifeedback, set to false by default;
  • Changed physiq.F to call soil.F with a new thermal inertia if tifeedback = true;
  • Added a routine called soil_tifeedback.F that computes the new thermal inertia of the subsurface when ice is deposited;

    Modified files: soil.F, physiq.F, inifis.F, callkeys.h
    Added files: soil_tifeedback.F

File size: 27.6 KB
Line 
1      SUBROUTINE inifis(
2     $           ngrid,nlayer
3     $           ,day_ini,pdaysec,ptimestep
4     $           ,plat,plon,parea
5     $           ,prad,pg,pr,pcpp
6#ifdef MESOSCALE
7#include "meso_inc/meso_inc_inifisinvar.F"
8#endif
9     $           )
10!
11!=======================================================================
12!
13!   purpose:
14!   -------
15!
16!   Initialisation for the physical parametrisations of the LMD
17!   martian atmospheric general circulation modele.
18!
19!   author: Frederic Hourdin 15 / 10 /93
20!   -------
21!   modified: Sebastien Lebonnois 11/06/2003 (new callphys.def)
22!             Ehouarn Millour (oct. 2008) tracers are now identified
23!              by their names and may not be contiguously
24!              stored in the q(:,:,:,:) array
25!             E.M. (june 2009) use getin routine to load parameters
26!             adapted to the mesoscale use - Aymeric Spiga - 01/2007-07/2011
27!
28!
29!   arguments:
30!   ----------
31!
32!   input:
33!   ------
34!
35!    ngrid                 Size of the horizontal grid.
36!                          All internal loops are performed on that grid.
37!    nlayer                Number of vertical layers.
38!    pdayref               Day of reference for the simulation
39!    pday                  Number of days counted from the North. Spring
40!                          equinoxe.
41!
42!=======================================================================
43!
44!-----------------------------------------------------------------------
45!   declarations:
46!   -------------
47! to use  'getin'
48      USE ioipsl_getincom
49      IMPLICIT NONE
50#include "dimensions.h"
51#include "dimphys.h"
52#include "planete.h"
53#include "comcstfi.h"
54#include "comsaison.h"
55#include "comdiurn.h"
56#include "comgeomfi.h"
57#include "callkeys.h"
58#include "surfdat.h"
59#include "dimradmars.h"
60#include "yomaer.h"
61#include "datafile.h"
62#include "slope.h"
63#include "microphys.h"
64#include "tracer.h"
65#ifdef MESOSCALE
66#include "comsoil.h"     !!MESOSCALE -- needed to fill volcapa
67#include "meso_inc/meso_inc_inifisvar.F"
68#endif
69      REAL prad,pg,pr,pcpp,pdaysec
70
71      REAL ptimestep
72      INTEGER day_ini
73
74      INTEGER ngrid,nlayer
75      REAL plat(ngrid),plon(ngrid),parea(ngridmx)
76      INTEGER ig,ierr
77 
78!      EXTERNAL iniorbit,orbite
79      EXTERNAL SSUM
80      REAL SSUM
81 
82      CHARACTER ch1*12
83      CHARACTER ch80*80
84
85!      logical chem, h2o
86
87!      chem = .false.
88!      h2o = .false.
89
90      rad=prad
91      cpp=pcpp
92      g=pg
93      r=pr
94      rcp=r/cpp
95      daysec=pdaysec
96      dtphys=ptimestep
97#ifdef MESOSCALE
98#include "meso_inc/meso_inc_inifisini.F"
99#endif
100
101! --------------------------------------------------------
102!     The usual Tests
103!     --------------
104      IF (nlayer.NE.nlayermx) THEN
105         PRINT*,'STOP in inifis'
106         PRINT*,'Probleme de dimensions :'
107         PRINT*,'nlayer     = ',nlayer
108         PRINT*,'nlayermx   = ',nlayermx
109         STOP
110      ENDIF
111
112      IF (ngrid.NE.ngridmx) THEN
113         PRINT*,'STOP in inifis'
114         PRINT*,'Probleme de dimensions :'
115         PRINT*,'ngrid     = ',ngrid
116         PRINT*,'ngridmx   = ',ngridmx
117         STOP
118      ENDIF
119
120! --------------------------------------------------------------
121!  Reading the "callphys.def" file controlling some key options
122! --------------------------------------------------------------
123     
124      ! check that 'callphys.def' file is around
125      OPEN(99,file='callphys.def',status='old',form='formatted'
126     &     ,iostat=ierr)
127      CLOSE(99)
128     
129      IF(ierr.EQ.0) THEN
130         PRINT*
131         PRINT*
132         PRINT*,'--------------------------------------------'
133         PRINT*,' inifis: Parameters for the physics (callphys.def)'
134         PRINT*,'--------------------------------------------'
135
136         write(*,*) "Directory where external input files are:"
137         datafile="/u/forget/WWW/datagcm/datafile"
138         call getin("datadir",datafile) ! default path
139         write(*,*) " datafile = ",trim(datafile)
140
141         write(*,*) "Run with or without tracer transport ?"
142         tracer=.false. ! default value
143         call getin("tracer",tracer)
144         write(*,*) " tracer = ",tracer
145
146         write(*,*) "Diurnal cycle ?"
147         write(*,*) "(if diurnal=False, diurnal averaged solar heating)"
148         diurnal=.true. ! default value
149         call getin("diurnal",diurnal)
150         write(*,*) " diurnal = ",diurnal
151
152         write(*,*) "Seasonal cycle ?"
153         write(*,*) "(if season=False, Ls stays constant, to value ",
154     &   "set in 'start'"
155         season=.true. ! default value
156         call getin("season",season)
157         write(*,*) " season = ",season
158
159         write(*,*) "Write some extra output to the screen ?"
160         lwrite=.false. ! default value
161         call getin("lwrite",lwrite)
162         write(*,*) " lwrite = ",lwrite
163
164         write(*,*) "Save statistics in file stats.nc ?"
165#ifdef MESOSCALE
166         callstats=.false. ! default value
167#else
168         callstats=.true. ! default value
169#endif
170         call getin("callstats",callstats)
171         write(*,*) " callstats = ",callstats
172
173         write(*,*) "Save EOF profiles in file 'profiles' for ",
174     &              "Climate Database?"
175         calleofdump=.false. ! default value
176         call getin("calleofdump",calleofdump)
177         write(*,*) " calleofdump = ",calleofdump
178
179         write(*,*) "Dust scenario: 1=constant dust (read from startfi",
180     &   " or set as tauvis); 2=Viking scenario; =3 MGS scenario,",
181     &   "=6 cold (low dust) scenario; =7 warm (high dust) scenario ",
182     &   "=24,25 ... 30 :Mars Year 24, ... or 30 from TES assimilation"
183         iaervar=3 ! default value
184         call getin("iaervar",iaervar)
185         write(*,*) " iaervar = ",iaervar
186
187         write(*,*) "Reference (visible) dust opacity at 610 Pa ",
188     &   "(matters only if iaervar=1)"
189         ! NB: default value of tauvis is set/read in startfi.nc file
190         call getin("tauvis",tauvis)
191         write(*,*) " tauvis = ",tauvis
192
193         write(*,*) "Dust vertical distribution:"
194         write(*,*) "(=1 top set by topdustref parameter;",
195     & " =2 Viking scenario; =3 MGS scenario)"
196         iddist=3 ! default value
197         call getin("iddist",iddist)
198         write(*,*) " iddist = ",iddist
199
200         write(*,*) "Dust top altitude (km). (Matters only if iddist=1)"
201         topdustref= 90.0 ! default value
202         call getin("topdustref",topdustref)
203         write(*,*) " topdustref = ",topdustref
204
205         write(*,*) "Prescribed surface thermal flux (H/(rho*cp),K m/s)"
206         tke_heat_flux=0. ! default value
207         call getin("tke_heat_flux",tke_heat_flux)
208         write(*,*) " tke_heat_flux = ",tke_heat_flux
209         write(*,*) " 0 means the usual schemes are computing"
210
211         write(*,*) "call radiative transfer ?"
212         callrad=.true. ! default value
213         call getin("callrad",callrad)
214         write(*,*) " callrad = ",callrad
215
216         write(*,*) "call slope insolation scheme ?",
217     &              "(matters only if callrad=T)"
218#ifdef MESOSCALE
219         callslope=.true. ! default value
220#else
221         callslope=.false. ! default value (not supported yet)
222#endif
223         call getin("callslope",callslope)
224         write(*,*) " callslope = ",callslope
225
226         write(*,*) "call NLTE radiative schemes ?",
227     &              "(matters only if callrad=T)"
228         callnlte=.false. ! default value
229         call getin("callnlte",callnlte)
230         write(*,*) " callnlte = ",callnlte
231         
232         nltemodel=0    !default value
233         write(*,*) "NLTE model?"
234         write(*,*) "0 -> old model, static O"
235         write(*,*) "1 -> old model, dynamic O"
236         write(*,*) "2 -> new model"
237         write(*,*) "(matters only if callnlte=T)"
238         call getin("nltemodel",nltemodel)
239         write(*,*) " nltemodel = ",nltemodel
240
241         write(*,*) "call CO2 NIR absorption ?",
242     &              "(matters only if callrad=T)"
243         callnirco2=.false. ! default value
244         call getin("callnirco2",callnirco2)
245         write(*,*) " callnirco2 = ",callnirco2
246
247         write(*,*) "New NIR NLTE correction ?",
248     $              "0-> old model (no correction)",
249     $              "1-> new correction",
250     $              "(matters only if callnirco2=T)"
251#ifdef MESOSCALE
252         nircorr=0      !default value. this is OK below 60 km.
253#else
254         nircorr=0      !default value
255#endif
256         call getin("nircorr",nircorr)
257         write(*,*) " nircorr = ",nircorr
258
259         write(*,*) "call turbulent vertical diffusion ?"
260         calldifv=.true. ! default value
261         call getin("calldifv",calldifv)
262         write(*,*) " calldifv = ",calldifv
263
264         write(*,*) "call thermals ?"
265         calltherm=.false. ! default value
266         call getin("calltherm",calltherm)
267         write(*,*) " calltherm = ",calltherm
268
269         write(*,*) "output thermal diagnostics ?"
270         outptherm=.false. ! default value
271         call getin("outptherm",outptherm)
272         write(*,*) " outptherm = ",outptherm
273
274         write(*,*) "call convective adjustment ?"
275         calladj=.true. ! default value
276         call getin("calladj",calladj)
277         write(*,*) " calladj = ",calladj
278         
279         if (calltherm .and. (.not. calladj)) then
280          print*,'Convadj has to be activated when using thermals'
281          stop
282         endif
283
284         write(*,*) "call Richardson-based surface layer ?"
285         callrichsl=.false. ! default value
286         call getin("callrichsl",callrichsl)
287         write(*,*) " callrichsl = ",callrichsl
288
289         if (calltherm .and. .not.callrichsl) then
290          print*,'WARNING WARNING WARNING'
291          print*,'if calltherm=T we strongly advise that '
292          print*,'you use the new surface layer scheme '
293          print*,'by setting callrichsl=T '
294         endif
295
296         if (calladj .and. callrichsl .and. (.not. calltherm)) then
297          print*,'You should not be calling the convective adjustment
298     & scheme with the Richardson surface-layer and without the thermals
299     &. This approach is not
300     & physically consistent and can lead to unrealistic friction
301     & values.'
302          print*,'If you want to use the Ri. surface-layer, either
303     & activate thermals OR de-activate the convective adjustment.'
304          stop
305         endif
306
307         write(*,*) "call CO2 condensation ?"
308         callcond=.true. ! default value
309         call getin("callcond",callcond)
310         write(*,*) " callcond = ",callcond
311
312         write(*,*)"call thermal conduction in the soil ?"
313         callsoil=.true. ! default value
314         call getin("callsoil",callsoil)
315         write(*,*) " callsoil = ",callsoil
316         
317
318         write(*,*)"call Lott's gravity wave/subgrid topography ",
319     &             "scheme ?"
320         calllott=.true. ! default value
321         call getin("calllott",calllott)
322         write(*,*)" calllott = ",calllott
323
324
325         write(*,*)"rad.transfer is computed every iradia",
326     &             " physical timestep"
327         iradia=1 ! default value
328         call getin("iradia",iradia)
329         write(*,*)" iradia = ",iradia
330         
331
332         write(*,*)"Output of the exchange coefficient mattrix ?",
333     &             "(for diagnostics only)"
334         callg2d=.false. ! default value
335         call getin("callg2d",callg2d)
336         write(*,*)" callg2d = ",callg2d
337
338         write(*,*)"Rayleigh scattering : (should be .false. for now)"
339         rayleigh=.false.
340         call getin("rayleigh",rayleigh)
341         write(*,*)" rayleigh = ",rayleigh
342
343
344! TRACERS:
345
346! dustbin
347         write(*,*)"Transported dust ? (if >0, use 'dustbin' dust bins)"
348         dustbin=0 ! default value
349         call getin("dustbin",dustbin)
350         write(*,*)" dustbin = ",dustbin
351! active
352         write(*,*)"Radiatively active dust ? (matters if dustbin>0)"
353         active=.false. ! default value
354         call getin("active",active)
355         write(*,*)" active = ",active
356
357! Test of incompatibility:
358! if active is used, then dustbin should be > 0
359
360         if (active.and.(dustbin.lt.1)) then
361           print*,'if active is used, then dustbin should > 0'
362           stop
363         endif
364! doubleq
365         write(*,*)"use mass and number mixing ratios to predict",
366     &             " dust size ?"
367         doubleq=.false. ! default value
368         call getin("doubleq",doubleq)
369         write(*,*)" doubleq = ",doubleq
370! submicron
371         submicron=.false. ! default value
372         call getin("submicron",submicron)
373         write(*,*)" submicron = ",submicron
374
375! Test of incompatibility:
376! if doubleq is used, then dustbin should be 2
377
378         if (doubleq.and.(dustbin.ne.2)) then
379           print*,'if doubleq is used, then dustbin should be 2'
380           stop
381         endif
382         if (doubleq.and.submicron.and.(nqmx.LT.3)) then
383           print*,'If doubleq is used with a submicron tracer,'
384           print*,' then the number of tracers has to be'
385           print*,' larger than 3.'
386           stop
387         endif
388! lifting
389         write(*,*)"dust lifted by GCM surface winds ?"
390         lifting=.false. ! default value
391         call getin("lifting",lifting)
392         write(*,*)" lifting = ",lifting
393
394! Test of incompatibility:
395! if lifting is used, then dustbin should be > 0
396
397         if (lifting.and.(dustbin.lt.1)) then
398           print*,'if lifting is used, then dustbin should > 0'
399           stop
400         endif
401! callddevil
402         write(*,*)" dust lifted by dust devils ?"
403         callddevil=.false. !default value
404         call getin("callddevil",callddevil)
405         write(*,*)" callddevil = ",callddevil
406
407! Test of incompatibility:
408! if dustdevil is used, then dustbin should be > 0
409
410         if (callddevil.and.(dustbin.lt.1)) then
411           print*,'if dustdevil is used, then dustbin should > 0'
412           stop
413         endif
414! sedimentation
415         write(*,*) "Gravitationnal sedimentation ?"
416         sedimentation=.true. ! default value
417         call getin("sedimentation",sedimentation)
418         write(*,*) " sedimentation = ",sedimentation
419! activice
420         write(*,*) "Radiatively active transported atmospheric ",
421     &              "water ice ?"
422         activice=.false. ! default value
423         call getin("activice",activice)
424         write(*,*) " activice = ",activice
425! water
426         write(*,*) "Compute water cycle ?"
427         water=.false. ! default value
428         call getin("water",water)
429         write(*,*) " water = ",water
430
431! thermal inertia feedback
432         write(*,*) "Activate the thermal inertia feedback ?"
433         tifeedback=.false. ! default value
434         call getin("tifeedback",tifeedback)
435         write(*,*) " tifeedback = ",tifeedback
436
437! Test of incompatibility:
438
439         if (tifeedback.and..not.water) then
440           print*,'if tifeedback is used,'
441           print*,'water should be used too'
442           stop
443         endif
444
445         if (tifeedback.and..not.callsoil) then
446           print*,'if tifeedback is used,'
447           print*,'callsoil should be used too'
448           stop
449         endif
450
451         if (activice.and..not.water) then
452           print*,'if activice is used, water should be used too'
453           stop
454         endif
455
456         if (water.and..not.tracer) then
457           print*,'if water is used, tracer should be used too'
458           stop
459         endif
460         
461! water ice clouds effective variance distribution for sedimentaion       
462        write(*,*) "effective variance for water ice clouds ?"
463        nuice_sed=0.45
464        call getin("nuice_sed",nuice_sed)
465        write(*,*) "water_param nueff Sedimentation:", nuice_sed
466         
467! ccn factor if no scavenging         
468        write(*,*) "water param CCN reduc. factor ?", ccn_factor
469        ccn_factor = 4.5
470        call getin("ccn_factor",ccn_factor)
471        write(*,*)" ccn_factor = ",ccn_factor
472        write(*,*)"Careful: only used when microphys=F, otherwise"
473        write(*,*)"the contact parameter is used instead;"
474
475! microphys
476         write(*,*)"Microphysical scheme for water-ice clouds?"
477         microphys=.false. ! default value
478         call getin("microphys",microphys)
479         write(*,*)" microphys = ",microphys
480
481! microphysical parameter contact       
482         write(*,*) "water contact parameter ?"
483         mteta  = 0.95
484         call getin("mteta",mteta)
485         write(*,*) "mteta = ", mteta
486
487! scavenging
488         write(*,*)"Dust scavenging by H2O/CO2 snowfall ?"
489         scavenging=.false. ! default value
490         call getin("scavenging",scavenging)
491         write(*,*)" scavenging = ",scavenging
492         
493
494! Test of incompatibility:
495! if scavenging is used, then dustbin should be > 0
496
497         if ((microphys.and..not.doubleq).or.
498     &       (microphys.and..not.water)) then
499             print*,'if microphys is used, then doubleq,'
500             print*,'and water must be used!'
501             stop
502         endif
503         if (microphys.and..not.scavenging) then
504             print*,''
505             print*,'----------------WARNING-----------------'
506             print*,'microphys is used without scavenging !!!'
507             print*,'----------------WARNING-----------------'
508             print*,''
509         endif
510
511         if ((scavenging.and..not.microphys).or.
512     &       (scavenging.and.(dustbin.lt.1))) then
513             print*,'if scavenging is used, then microphys'
514             print*,'must be used!'
515             stop
516         endif
517
518! Test of incompatibility:
519
520         write(*,*) "Permanent water caps at poles ?",
521     &               " .true. is RECOMMENDED"
522         write(*,*) "(with .true., North cap is a source of water ",
523     &   "and South pole is a cold trap)"
524         caps=.true. ! default value
525         call getin("caps",caps)
526         write(*,*) " caps = ",caps
527
528! albedo_h2o_ice
529         write(*,*) "water ice albedo ?"
530         albedo_h2o_ice=0.45
531         call getin("albedo_h2o_ice",albedo_h2o_ice)
532         write(*,*) " albedo_h2o_ice = ",albedo_h2o_ice
533! inert_h2o_ice
534         write(*,*) "water ice thermal inertia ?"
535         inert_h2o_ice=2400 ! (J.m^-2.K^-1.s^-1/2)
536         call getin("inert_h2o_ice",inert_h2o_ice)
537         write(*,*) " inert_h2o_ice = ",inert_h2o_ice
538! frost_albedo_threshold
539         write(*,*) "frost thickness threshold for albedo ?"
540         frost_albedo_threshold=0.005 ! 5.4 mic (i.e 0.005 kg.m-2)
541         call getin("frost_albedo_threshold",
542     &    frost_albedo_threshold)
543         write(*,*) " frost_albedo_threshold = ",
544     &            frost_albedo_threshold
545
546! call Titus crocus line -- DEFAULT IS NONE
547         write(*,*) "Titus crocus line ?"
548         tituscap=.false.  ! default value
549         call getin("tituscap",tituscap)
550         write(*,*) "tituscap",tituscap
551                     
552
553         write(*,*) "photochemistry: include chemical species"
554         photochem=.false. ! default value
555         call getin("photochem",photochem)
556         write(*,*) " photochem = ",photochem
557
558
559! THERMOSPHERE
560
561         write(*,*) "call thermosphere ?"
562         callthermos=.false. ! default value
563         call getin("callthermos",callthermos)
564         write(*,*) " callthermos = ",callthermos
565         
566
567         write(*,*) " water included without cycle ",
568     &              "(only if water=.false.)"
569         thermoswater=.false. ! default value
570         call getin("thermoswater",thermoswater)
571         write(*,*) " thermoswater = ",thermoswater
572
573         write(*,*) "call thermal conduction ?",
574     &    " (only if callthermos=.true.)"
575         callconduct=.false. ! default value
576         call getin("callconduct",callconduct)
577         write(*,*) " callconduct = ",callconduct
578
579         write(*,*) "call EUV heating ?",
580     &   " (only if callthermos=.true.)"
581         calleuv=.false.  ! default value
582         call getin("calleuv",calleuv)
583         write(*,*) " calleuv = ",calleuv
584
585         write(*,*) "call molecular viscosity ?",
586     &   " (only if callthermos=.true.)"
587         callmolvis=.false. ! default value
588         call getin("callmolvis",callmolvis)
589         write(*,*) " callmolvis = ",callmolvis
590
591         write(*,*) "call molecular diffusion ?",
592     &   " (only if callthermos=.true.)"
593         callmoldiff=.false. ! default value
594         call getin("callmoldiff",callmoldiff)
595         write(*,*) " callmoldiff = ",callmoldiff
596         
597
598         write(*,*) "call thermospheric photochemistry ?",
599     &   " (only if callthermos=.true.)"
600         thermochem=.false. ! default value
601         call getin("thermochem",thermochem)
602         write(*,*) " thermochem = ",thermochem
603
604         write(*,*) "Method to include solar variability"
605         write(*,*) "0-> old method (using solarcondate); ",
606     &                  "1-> variability wit E10.7"
607         solvarmod=1
608         call getin("solvarmod",solvarmod)
609         write(*,*) " solvarmod = ",solvarmod
610
611         write(*,*) "date for solar flux calculation:",
612     &   " (1985 < date < 2002)",
613     $   " (Only used if solvarmod=0)"
614         write(*,*) "(Solar min=1996.4 ave=1993.4 max=1990.6)"
615         solarcondate=1993.4 ! default value
616         call getin("solarcondate",solarcondate)
617         write(*,*) " solarcondate = ",solarcondate
618         
619         write(*,*) "Solar variability as observed for MY: "
620         write(*,*) "Only if solvarmod=1"
621         solvaryear=24
622         call getin("solvaryear",solvaryear)
623         write(*,*) " solvaryear = ",solvaryear
624
625         write(*,*) "UV heating efficiency:",
626     &   "measured values between 0.19 and 0.23 (Fox et al. 1996)",
627     &   "lower values may be used to compensate low 15 um cooling"
628         euveff=0.21 !default value
629         call getin("euveff",euveff)
630         write(*,*) " euveff = ", euveff
631
632         if (.not.callthermos) then
633           if (thermoswater) then
634             print*,'if thermoswater is set, callthermos must be true'
635             stop
636           endif         
637           if (callconduct) then
638             print*,'if callconduct is set, callthermos must be true'
639             stop
640           endif       
641           if (calleuv) then
642             print*,'if calleuv is set, callthermos must be true'
643             stop
644           endif         
645           if (callmolvis) then
646             print*,'if callmolvis is set, callthermos must be true'
647             stop
648           endif       
649           if (callmoldiff) then
650             print*,'if callmoldiff is set, callthermos must be true'
651             stop
652           endif         
653           if (thermochem) then
654             print*,'if thermochem is set, callthermos must be true'
655             stop
656           endif         
657        endif
658
659! Test of incompatibility:
660! if photochem is used, then water should be used too
661
662         if (photochem.and..not.water) then
663           print*,'if photochem is used, water should be used too'
664           stop
665         endif
666
667! if callthermos is used, then thermoswater should be used too
668! (if water not used already)
669
670         if (callthermos .and. .not.water) then
671           if (callthermos .and. .not.thermoswater) then
672             print*,'if callthermos is used, water or thermoswater
673     &               should be used too'
674             stop
675           endif
676         endif
677
678         PRINT*,'--------------------------------------------'
679         PRINT*
680         PRINT*
681      ELSE
682         write(*,*)
683         write(*,*) 'Cannot read file callphys.def. Is it here ?'
684         stop
685      ENDIF
686
6878000  FORMAT(t5,a12,l8)
6888001  FORMAT(t5,a12,i8)
689
690      PRINT*
691      PRINT*,'inifis: daysec',daysec
692      PRINT*
693      PRINT*,'inifis: The radiative transfer is computed:'
694      PRINT*,'           each ',iradia,' physical time-step'
695      PRINT*,'        or each ',iradia*dtphys,' seconds'
696      PRINT*
697! --------------------------------------------------------------
698!  Managing the Longwave radiative transfer
699! --------------------------------------------------------------
700
701!     In most cases, the run just use the following values :
702!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
703      callemis=.true.     
704!     ilwd=10*int(daysec/dtphys) ! bug before 22/10/01       
705      ilwd=1
706      ilwn=1 !2
707      ilwb=1 !2
708      linear=.true.       
709      ncouche=3
710      alphan=0.4
711      semi=0
712
713!     BUT people working hard on the LW may want to read them in 'radia.def'
714!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
715
716      OPEN(99,file='radia.def',status='old',form='formatted'
717     .     ,iostat=ierr)
718      IF(ierr.EQ.0) THEN
719         write(*,*) 'inifis: Reading radia.def !!!'
720         READ(99,fmt='(a)') ch1
721         READ(99,*) callemis
722         WRITE(*,8000) ch1,callemis
723
724         READ(99,fmt='(a)') ch1
725         READ(99,*) iradia
726         WRITE(*,8001) ch1,iradia
727
728         READ(99,fmt='(a)') ch1
729         READ(99,*) ilwd
730         WRITE(*,8001) ch1,ilwd
731
732         READ(99,fmt='(a)') ch1
733         READ(99,*) ilwn
734         WRITE(*,8001) ch1,ilwn
735
736         READ(99,fmt='(a)') ch1
737         READ(99,*) linear
738         WRITE(*,8000) ch1,linear
739
740         READ(99,fmt='(a)') ch1
741         READ(99,*) ncouche
742         WRITE(*,8001) ch1,ncouche
743
744         READ(99,fmt='(a)') ch1
745         READ(99,*) alphan
746         WRITE(*,*) ch1,alphan
747
748         READ(99,fmt='(a)') ch1
749         READ(99,*) ilwb
750         WRITE(*,8001) ch1,ilwb
751
752
753         READ(99,fmt='(a)') ch1
754         READ(99,'(l1)') callg2d
755         WRITE(*,8000) ch1,callg2d
756
757         READ(99,fmt='(a)') ch1
758         READ(99,*) semi
759         WRITE(*,*) ch1,semi
760      end if
761      CLOSE(99)
762
763!-----------------------------------------------------------------------
764!     Some more initialization:
765!     ------------------------
766
767      ! in 'comgeomfi.h'
768      CALL SCOPY(ngrid,plon,1,long,1)
769      CALL SCOPY(ngrid,plat,1,lati,1)
770      CALL SCOPY(ngrid,parea,1,area,1)
771      totarea=SSUM(ngridmx,area,1)
772
773      ! in 'comdiurn.h'
774      DO ig=1,ngrid
775         sinlat(ig)=sin(plat(ig))
776         coslat(ig)=cos(plat(ig))
777         sinlon(ig)=sin(plon(ig))
778         coslon(ig)=cos(plon(ig))
779      ENDDO
780
781      pi=2.*asin(1.) ! NB: pi is a common in comcstfi.h
782
783!     managing the tracers, and tests:
784!     -------------------------------
785!     Ehouarn: removed; as these tests are now done in initracer.F
786!      if(tracer) then
787!
788!!          when photochem is used, nqchem_min is the rank
789!!          of the first chemical species
790!
791!! Ehouarn: nqchem_min is now meaningless and no longer used
792!!       nqchem_min = 1
793!       if (photochem .or. callthermos) then
794!         chem = .true.
795!       end if
796!
797!       if (water .or. thermoswater) h2o = .true.
798!
799!!          TESTS
800!
801!       print*,'inifis: TRACERS:'
802!       write(*,*) "    chem=",chem,"    h2o=",h2o
803!!       write(*,*) "   doubleq=",doubleq
804!!       write(*,*) "   dustbin=",dustbin
805!
806!       if ((doubleq).and.(h2o).and.
807!     $     (chem)) then
808!         print*,' 2 dust tracers (doubleq)'
809!         print*,' 1 water vapour tracer'
810!         print*,' 1 water ice tracer'
811!         print*,nqmx-4,' chemistry tracers'
812!       endif
813!
814!       if ((doubleq).and.(h2o).and.
815!     $     .not.(chem)) then
816!         print*,' 2 dust tracers (doubleq)'
817!         print*,' 1 water vapour tracer'
818!         print*,' 1 water ice tracer'
819!         if (nqmx.LT.4) then
820!           print*,'nqmx should be at least equal to'
821!           print*,'4 with these options.'
822!           stop
823!         endif
824!       endif
825!
826!       if (.not.(doubleq).and.(h2o).and.
827!     $     (chem)) then
828!         if (dustbin.gt.0) then
829!           print*,dustbin,' dust bins'
830!         endif
831!         print*,nqmx-2-dustbin,' chemistry tracers'
832!         print*,' 1 water vapour tracer'
833!         print*,' 1 water ice tracer'
834!       endif
835!
836!       if (.not.(doubleq).and.(h2o).and.
837!     $     .not.(chem)) then
838!         if (dustbin.gt.0) then
839!           print*,dustbin,' dust bins'
840!         endif
841!         print*,' 1 water vapour tracer'
842!         print*,' 1 water ice tracer'
843!         if (nqmx.gt.(dustbin+2)) then
844!           print*,'nqmx should be ',(dustbin+2),
845!     $            ' with these options...'
846!                  print*,'(or check callphys.def)'
847!         endif
848!         if (nqmx.lt.(dustbin+2)) then
849!           write(*,*) "inifis: nqmx.lt.(dustbin+2)"
850!           stop
851!         endif
852!       endif
853!
854!      endif ! of if (tracer)
855!
856!      RETURN
857      END
Note: See TracBrowser for help on using the repository browser.