source: trunk/LMDZ.PLUTO/libf/phypluto/tabfi_mod.F90 @ 3955

Last change on this file since 3955 was 3936, checked in by tbertrand, 2 months ago

PLUTO PCM : correcting a bug in hazecloud (wrong lyman alpha fluxes due to mu0 being negative during nighttime) + cleaning routines
TB

File size: 23.6 KB
Line 
1MODULE tabfi_mod
2
3IMPLICIT NONE
4
5real, save :: tab_cntrl_mod(100)
6!$OMP THREADPRIVATE(tab_cntrl_mod)
7
8CONTAINS
9
10!=======================================================================
11      SUBROUTINE tabfi(ngrid,nid,Lmodif,tab0,day_ini,lmax,p_rad, &
12                       p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
13!=======================================================================
14!
15!   C. Hourdin 15/11/96
16!
17!   Object:        Lecture du tab_cntrl physique dans un fichier
18!   ------            et initialisation des constantes physiques
19!
20!   Arguments:
21!   ----------
22!
23!     Inputs:
24!     ------
25!
26!      - nid:    unitne logique du fichier ou on va lire le tab_cntrl
27!                      (ouvert dans le programme appellant)
28!
29!                 si nid=0:
30!                       pas de lecture du tab_cntrl mais
31!                       Valeurs par default des constantes physiques
32!
33!      - tab0:    Offset de tab_cntrl a partir duquel sont ranges
34!                  les parametres physiques (50 pour start_archive)
35!
36!      - Lmodif:  si on souhaite modifier les constantes  Lmodif = 1 = TRUE
37!
38!
39!     Outputs:
40!     --------
41!
42!      - day_ini: tab_cntrl(tab0+3) (Dans les cas ou l'on souhaite
43!                              comparer avec le day_ini dynamique)
44!
45!      - lmax:    tab_cntrl(tab0+2) (pour test avec nlayer)
46!
47!      - p_rad
48!      - p_omeg   !
49!      - p_g      ! Constantes physiques ayant des
50!      - p_mugaz  ! homonymes dynamiques
51!      - p_daysec !
52!
53!=======================================================================
54! to use  'getin_p'
55      use ioipsl_getin_p_mod, only: getin_p
56
57      use surfdat_h, only: emisice, iceradius, dtemisice, &
58                           emissiv
59      use comsoil_h, only: volcapa
60      use iostart, only: get_var
61      use mod_phys_lmdz_para, only: is_parallel
62      use planete_mod, only: year_day, periastr, apoastr, peri_day, &
63                             obliquit, z0, lmixmin, emin_turb, &
64                             tpal, adjust
65      use comcstfi_mod, only: rad, omeg, g, mugaz, rcp, cpp, r
66      use time_phylmdz_mod, only: dtphys, daysec
67      use callkeys_mod, only: cpp_mugaz_mode
68      implicit none
69
70      include "netcdf.inc"
71
72!-----------------------------------------------------------------------
73!   Declarations
74!-----------------------------------------------------------------------
75
76! Arguments
77! ---------
78      INTEGER,INTENT(IN) :: ngrid,nid,tab0
79      INTEGER*4,INTENT(OUT) :: day_ini
80      INTEGER,INTENT(IN) :: Lmodif
81      INTEGER,INTENT(OUT) :: lmax
82      REAL,INTENT(OUT) :: p_rad,p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time
83
84! Variables
85! ---------
86      INTEGER,PARAMETER :: length=100
87      REAL tab_cntrl(length) ! array in which are stored the run's parameters
88      INTEGER  ierr,nvarid
89      INTEGER size
90      CHARACTER modif*20
91      LOGICAL :: found
92      CHARACTER(len=5) :: modname="tabfi"
93
94      write(*,*)"tabfi: nid=",nid," tab0=",tab0," Lmodif=",Lmodif
95
96      IF (nid.eq.0) then
97!-----------------------------------------------------------------------
98!  Initialization of various physical constants to defaut values (nid = 0 case)
99!-----------------------------------------------------------------------
100        tab_cntrl(:)=0
101        lmax=0 ! not used anyways
102        !day_ini already set via inifis
103        time=0
104! Informations about planet for dynamics and physics
105        ! rad,cpp,g,r,rcp already initialized by inifis
106        omeg=-999.
107        call getin_p("omega",omeg)
108        if (omeg.eq.-999.) then
109          call abort_physic(modname,"Missing value for omega in def files!",1)
110        endif
111        mugaz=(8.3144621/r)*1.E3
112        ! daysec already set by inifis
113        ! dtphys alread set by inifis
114! Informations about planet for the physics only
115        year_day=-999. ! length of year, in standard days
116        call getin_p("year_day",year_day)
117        if (year_day.eq.-999.) then
118          call abort_physic(modname, &
119               "Missing value for year_day in def files!",1)
120        endif
121        periastr=-999.
122        call getin_p("periastron",periastr)
123        if (periastr.eq.-999.) then
124          call abort_physic(modname, &
125               "Missing value for periastron in def files!",1)
126        endif
127        apoastr=-999.
128        call getin_p("apoastron",apoastr)
129        if (apoastr.eq.-999.) then
130          call abort_physic(modname, &
131               "Missing value for apoastron in def files!",1)
132        endif
133        peri_day=-999.
134        call getin_p("periastron_day",peri_day)
135        if (peri_day.eq.-999.) then
136          call abort_physic(modname, &
137               "Missing value for periastron_day in def files!",1)
138        endif
139        obliquit=-999.
140        call getin_p("obliquity",obliquit)
141        if (obliquit.eq.-999.) then
142          call abort_physic(modname, &
143               "Missing value for obliquity in def files!",1)
144        endif
145! boundary layer and turbulence
146        z0=1.e-2 ! surface roughness length (m)
147        lmixmin=30
148        emin_turb=1.e-6
149! optical properties of polar caps and ground emissivity
150        emisice(:)=0
151        emissiv=0
152        iceradius(:)=1.e-6 ! mean scat radius of N2 snow
153        dtemisice(:)=0 !time scale for snow metamorphism
154        volcapa=1000000 ! volumetric heat capacity of subsurface
155        tpal=0.
156        adjust=0.
157
158      ELSE
159!-----------------------------------------------------------------------
160!  Initialization of physical constants by reading array tab_cntrl(:)
161!               which contains these parameters (nid != 0 case)
162!-----------------------------------------------------------------------
163! Read 'controle' array
164!
165
166       call get_var(nid,"controle",tab_cntrl,found)
167       if (.not.found) then
168         call abort_physic(modname,"Failed reading <controle> array",1)
169       else
170         write(*,*)'tabfi: tab_cntrl',tab_cntrl
171       endif
172!
173!  Initialization of some physical constants
174! informations on physics grid
175!      if(ngrid.ne.tab_cntrl(tab0+1)) then
176!         print*,'tabfi: WARNING !!! tab_cntrl(tab0+1).ne.ngrid'
177!         print*,tab_cntrl(tab0+1),ngrid
178!      endif
179      lmax = nint(tab_cntrl(tab0+2))
180      day_ini = tab_cntrl(tab0+3)
181      time = tab_cntrl(tab0+4)
182      write (*,*) 'IN tabfi day_ini=',day_ini
183! Informations about planet for dynamics and physics
184      rad = tab_cntrl(tab0+5)
185      omeg = tab_cntrl(tab0+6)
186      g = tab_cntrl(tab0+7)
187      mugaz = tab_cntrl(tab0+8)
188      rcp = tab_cntrl(tab0+9)
189      cpp=(8.314511/(mugaz/1000.0))/rcp
190      daysec = tab_cntrl(tab0+10)
191      dtphys = tab_cntrl(tab0+11)
192! Informations about planet for the physics only
193      year_day = tab_cntrl(tab0+14)
194      periastr = tab_cntrl(tab0+15)
195      apoastr = tab_cntrl(tab0+16)
196      peri_day = tab_cntrl(tab0+17)
197      obliquit = tab_cntrl(tab0+18)
198! boundary layer and turbulence
199      z0 = tab_cntrl(tab0+19)
200! for paleoclimate
201      tpal = tab_cntrl(tab0+20)
202      adjust = tab_cntrl(tab0+21) ! for Triton albedo adjustment
203      ! lmixmin = tab_cntrl(tab0+20)
204      ! emin_turb = tab_cntrl(tab0+21)
205
206!!! AF24: parameters below are not used?
207! optical properties of polar caps and ground emissivity
208      emisice(1) = tab_cntrl(tab0+24)
209      emisice(2) = tab_cntrl(tab0+25)
210      emissiv    = tab_cntrl(tab0+26)
211      iceradius(1)= tab_cntrl(tab0+31) ! mean scat radius of N2 snow (north)
212      iceradius(2)= tab_cntrl(tab0+32) ! mean scat radius of N2 snow (south)
213      dtemisice(1)= tab_cntrl(tab0+33) !time scale for snow metamorphism (north)
214      dtemisice(2)= tab_cntrl(tab0+34) !time scale for snow metamorphism (south)
215! soil properties
216      volcapa = tab_cntrl(tab0+35) ! volumetric heat capacity
217!-----------------------------------------------------------------------
218!       Save some constants for later use (as routine arguments)
219!-----------------------------------------------------------------------
220      p_omeg = omeg
221      p_g = g
222      p_cpp = cpp
223      p_mugaz = mugaz
224      p_daysec = daysec
225      p_rad=rad
226
227      ENDIF    ! end of (nid = 0)
228
229!-----------------------------------------------------------------------
230!       Write physical constants to output before modifying them
231!-----------------------------------------------------------------------
232
233   6  FORMAT(a20,e15.6,e15.6)
234   5  FORMAT(a20,f12.2,f12.2)
235
236      write(*,*) '*****************************************************'
237      write(*,*) 'Reading tab_cntrl when calling tabfi before changes'
238      write(*,*) '*****************************************************'
239      write(*,5) '(1)        = ngrid?',tab_cntrl(tab0+1),float(ngrid)
240      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
241      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
242      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
243      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
244      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
245      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
246      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
247      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
248      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
249
250      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
251      write(*,5) '(15)       periastr',tab_cntrl(tab0+15),periastr
252      write(*,5) '(16)        apoastr',tab_cntrl(tab0+16),apoastr
253      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
254      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
255
256      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
257      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
258      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
259
260      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
261      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
262      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
263      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
264      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
265      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
266      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
267
268      write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
269
270      write(*,*)
271      write(*,*) 'Lmodif in tabfi!!!!!!!',Lmodif
272
273!-----------------------------------------------------------------------
274!        Modifications...
275! NB: Modifying controls should only be done by newstart, and in seq mode
276      if ((Lmodif.eq.1).and.is_parallel) then
277        write(*,*) "tabfi: Error modifying tab_control should", &
278                   " only happen in serial mode (eg: by newstart)"
279        stop
280      endif
281!-----------------------------------------------------------------------
282
283      IF(Lmodif.eq.1) then
284
285      write(*,*)
286      write(*,*) 'Change values in tab_cntrl ? :'
287      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
288      write(*,*) '(Current values given above)'
289      write(*,*)
290      write(*,*) '(3)          day_ini : Initial day (=0 at Ls=0)'
291      write(*,*) '(19)              z0 :  surface roughness (m)'
292      write(*,*) '(21)       emin_turb :  minimal energy (PBL)'
293      write(*,*) '(20)         lmixmin : mixing length (PBL)'
294      write(*,*) '(26)         emissiv : ground emissivity'
295      write(*,*) '(24 et 25)   emisice : N2 ice max emissivity '
296      write(*,*) '(31 et 32) iceradius : mean scat radius of N2 snow'
297      write(*,*) '(33 et 34) dtemisice : time scale for snow metamorphism'
298      write(*,*) '(35)      volcapa : soil volumetric heat capacity'
299      write(*,*) '(18)     obliquit : planet obliquity (deg)'
300      write(*,*) '(17)     peri_day : periastron date (sols since Ls=0)'
301      write(*,*) '(15)     periastr : min. star-planet dist (UA)'
302      write(*,*) '(16)     apoastr  : max. star-planet (UA)'
303      write(*,*) '(14)     year_day : length of year (in sols)'
304      write(*,*) '(5)      rad      : radius of the planet (m)'
305      write(*,*) '(6)      omeg     : planet rotation rate (rad/s)'
306      write(*,*) '(7)      g        : gravity (m/s2)'
307      write(*,*) '(8)      mugaz    : molecular mass '
308      write(*,*) '                       of the atmosphere (g/mol)'
309      write(*,*) '(9)      rcp      : r/Cp'
310      write(*,*) '(8)+(9)  calc_cpp_mugaz : r/Cp and mugaz '
311      write(*,*) '                 computed from gases.def'
312      write(*,*) '(10)     daysec   : length of a sol (s)'
313      write(*,*)
314
315
316      do while(modif(1:1).ne.'hello')
317        write(*,*)
318        write(*,*)
319        write(*,*) 'Changes to perform ?'
320        write(*,*) '   (enter keyword or return )'
321        write(*,*)
322        read(*,fmt='(a20)') modif
323        if (modif(1:1) .eq. ' ') goto 999
324
325        write(*,*)
326        write(*,*) modif(1:len_trim(modif)) , ' : '
327
328        if (modif(1:len_trim(modif)) .eq. 'day_ini') then
329          write(*,*) 'current value:',day_ini
330          write(*,*) 'enter new value:'
331 101      read(*,*,iostat=ierr) day_ini
332          if(ierr.ne.0) goto 101
333          write(*,*) ' '
334          write(*,*) 'day_ini (new value):',day_ini
335
336        else if (modif(1:len_trim(modif)) .eq. 'z0') then
337          write(*,*) 'current value:',z0
338          write(*,*) 'enter new value:'
339 102      read(*,*,iostat=ierr) z0
340          if(ierr.ne.0) goto 102
341          write(*,*) ' '
342          write(*,*) ' z0 (new value):',z0
343
344        else if (modif(1:len_trim(modif)) .eq. 'emin_turb') then
345          write(*,*) 'current value:',emin_turb
346          write(*,*) 'enter new value:'
347 103      read(*,*,iostat=ierr) emin_turb
348          if(ierr.ne.0) goto 103
349          write(*,*) ' '
350          write(*,*) ' emin_turb (new value):',emin_turb
351
352        else if (modif(1:len_trim(modif)) .eq. 'lmixmin') then
353          write(*,*) 'current value:',lmixmin
354          write(*,*) 'enter new value:'
355 104      read(*,*,iostat=ierr) lmixmin
356          if(ierr.ne.0) goto 104
357          write(*,*) ' '
358          write(*,*) ' lmixmin (new value):',lmixmin
359
360        else if (modif(1:len_trim(modif)) .eq. 'emissiv') then
361          write(*,*) 'current value:',emissiv
362          write(*,*) 'enter new value:'
363 105      read(*,*,iostat=ierr) emissiv
364          if(ierr.ne.0) goto 105
365          write(*,*) ' '
366          write(*,*) ' emissiv (new value):',emissiv
367
368        else if (modif(1:len_trim(modif)) .eq. 'emisice') then
369          write(*,*) 'current value emisice(1) North:',emisice(1)
370          write(*,*) 'enter new value:'
371 106      read(*,*,iostat=ierr) emisice(1)
372          if(ierr.ne.0) goto 106
373          write(*,*)
374          write(*,*) ' emisice(1) (new value):',emisice(1)
375          write(*,*)
376
377          write(*,*) 'current value emisice(2) South:',emisice(2)
378          write(*,*) 'enter new value:'
379 107      read(*,*,iostat=ierr) emisice(2)
380          if(ierr.ne.0) goto 107
381          write(*,*)
382          write(*,*) ' emisice(2) (new value):',emisice(2)
383
384        else if (modif(1:len_trim(modif)) .eq. 'iceradius') then
385          write(*,*) 'current value iceradius(1) North:',iceradius(1)
386          write(*,*) 'enter new value:'
387 110      read(*,*,iostat=ierr) iceradius(1)
388          if(ierr.ne.0) goto 110
389          write(*,*)
390          write(*,*) ' iceradius(1) (new value):',iceradius(1)
391          write(*,*)
392
393          write(*,*) 'current value iceradius(2) South:',iceradius(2)
394          write(*,*) 'enter new value:'
395 111      read(*,*,iostat=ierr) iceradius(2)
396          if(ierr.ne.0) goto 111
397          write(*,*)
398          write(*,*) ' iceradius(2) (new value):',iceradius(2)
399
400        else if (modif(1:len_trim(modif)) .eq. 'dtemisice') then
401          write(*,*) 'current value dtemisice(1) North:',dtemisice(1)
402          write(*,*) 'enter new value:'
403 112      read(*,*,iostat=ierr) dtemisice(1)
404          if(ierr.ne.0) goto 112
405          write(*,*)
406          write(*,*) ' dtemisice(1) (new value):',dtemisice(1)
407          write(*,*)
408
409          write(*,*) 'current value dtemisice(2) South:',dtemisice(2)
410          write(*,*) 'enter new value:'
411 113      read(*,*,iostat=ierr) dtemisice(2)
412          if(ierr.ne.0) goto 113
413          write(*,*)
414          write(*,*) ' dtemisice(2) (new value):',dtemisice(2)
415
416        else if (modif(1:len_trim(modif)) .eq. 'obliquit') then
417          write(*,*) 'current value:',obliquit
418          write(*,*) 'obliquit should be 25.19 on current Mars'
419          write(*,*) 'enter new value:'
420 115      read(*,*,iostat=ierr) obliquit
421          if(ierr.ne.0) goto 115
422          write(*,*)
423          write(*,*) ' obliquit (new value):',obliquit
424
425        else if (modif(1:len_trim(modif)) .eq. 'peri_day') then
426          write(*,*) 'current value:',peri_day
427          write(*,*) 'peri_day should be 485 on current Mars'
428          write(*,*) 'enter new value:'
429 116      read(*,*,iostat=ierr) peri_day
430          if(ierr.ne.0) goto 116
431          write(*,*)
432          write(*,*) ' peri_day (new value):',peri_day
433
434        else if (modif(1:len_trim(modif)) .eq. 'periastr') then
435          write(*,*) 'current value:',periastr
436          write(*,*) 'periastr should be 1.3814 AU on present-day Mars'
437          write(*,*) 'enter new value:'
438 117      read(*,*,iostat=ierr) periastr
439          if(ierr.ne.0) goto 117
440          write(*,*)
441          write(*,*) ' periastr (new value):',periastr
442
443        else if (modif(1:len_trim(modif)) .eq. 'apoastr') then
444          write(*,*) 'current value:',apoastr
445          write(*,*) 'apoastr should be 1.666 AU on present-day Mars'
446          write(*,*) 'enter new value:'
447 118      read(*,*,iostat=ierr) apoastr
448          if(ierr.ne.0) goto 118
449          write(*,*)
450          write(*,*) ' apoastr (new value):',apoastr
451
452        else if (modif(1:len_trim(modif)) .eq. 'volcapa') then
453          write(*,*) 'current value:',volcapa
454          write(*,*) 'enter new value:'
455 119      read(*,*,iostat=ierr) volcapa
456          if(ierr.ne.0) goto 119
457          write(*,*)
458          write(*,*) ' volcapa (new value):',volcapa
459
460        else if (modif(1:len_trim(modif)).eq.'rad') then
461          write(*,*) 'current value:',rad
462          write(*,*) 'enter new value:'
463 120      read(*,*,iostat=ierr) rad
464          if(ierr.ne.0) goto 120
465          write(*,*)
466          write(*,*) ' rad (new value):',rad
467
468        else if (modif(1:len_trim(modif)).eq.'omeg') then
469          write(*,*) 'current value:',omeg
470          write(*,*) 'enter new value:'
471 121      read(*,*,iostat=ierr) omeg
472          if(ierr.ne.0) goto 121
473          write(*,*)
474          write(*,*) ' omeg (new value):',omeg
475
476        else if (modif(1:len_trim(modif)).eq.'g') then
477          write(*,*) 'current value:',g
478          write(*,*) 'enter new value:'
479 122      read(*,*,iostat=ierr) g
480          if(ierr.ne.0) goto 122
481          write(*,*)
482          write(*,*) ' g (new value):',g
483
484        else if (modif(1:len_trim(modif)).eq.'mugaz') then
485          write(*,*) 'current value:',mugaz
486          write(*,*) 'enter new value:'
487 123      read(*,*,iostat=ierr) mugaz
488          if(ierr.ne.0) goto 123
489          write(*,*)
490          write(*,*) ' mugaz (new value):',mugaz
491          r=8.314511/(mugaz/1000.0)
492          write(*,*) ' R (new value):',r
493
494        else if (modif(1:len_trim(modif)).eq.'rcp') then
495          write(*,*) 'current value:',rcp
496          write(*,*) 'enter new value:'
497 124      read(*,*,iostat=ierr) rcp
498          if(ierr.ne.0) goto 124
499          write(*,*)
500          write(*,*) ' rcp (new value):',rcp
501          r=8.314511/(mugaz/1000.0)
502          cpp=r/rcp
503          write(*,*) ' cpp (new value):',cpp
504
505        else if (modif(1:len_trim(modif)).eq.'calc_cpp_mugaz') then
506          write(*,*) 'current value rcp, mugaz:',rcp,mugaz
507          cpp_mugaz_mode = 2
508          call su_gases
509          call calc_cpp_mugaz
510          write(*,*)
511          write(*,*) ' cpp (new value):',cpp
512          write(*,*) ' mugaz (new value):',mugaz
513          r=8.314511/(mugaz/1000.0)
514          rcp=r/cpp
515          write(*,*) ' rcp (new value):',rcp
516
517        else if (modif(1:len_trim(modif)).eq.'daysec') then
518          write(*,*) 'current value:',daysec
519          write(*,*) 'enter new value:'
520 125      read(*,*,iostat=ierr) daysec
521          if(ierr.ne.0) goto 125
522          write(*,*)
523          write(*,*) ' daysec (new value):',daysec
524
525!         added by RW!
526        else if (modif(1:len_trim(modif)).eq.'year_day') then
527          write(*,*) 'current value:',year_day
528          write(*,*) 'enter new value:'
529 126      read(*,*,iostat=ierr) year_day
530          if(ierr.ne.0) goto 126
531          write(*,*)
532          write(*,*) ' year_day (new value):',year_day
533
534        endif
535      enddo ! of do while(modif(1:1).ne.'hello')
536
537 999  continue
538
539!----------------------------------------------------------------------
540!       Write values of physical constants after modifications
541!-----------------------------------------------------------------------
542
543      write(*,*) '*****************************************************'
544      write(*,*) 'Reading tab_cntrl when calling tabfi AFTER changes'
545      write(*,*) '*****************************************************'
546      write(*,5) '(1)        = ngrid?',tab_cntrl(tab0+1),float(ngrid)
547      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
548      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
549      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
550      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
551      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
552      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
553      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
554      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
555      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
556
557      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
558      write(*,5) '(15)       periastr',tab_cntrl(tab0+15),periastr
559      write(*,5) '(16)        apoastr',tab_cntrl(tab0+16),apoastr
560      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
561      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
562
563      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
564      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
565      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
566
567      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
568      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
569      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
570      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
571      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
572      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
573      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
574
575      write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
576
577      write(*,*)
578      write(*,*)
579
580      ENDIF ! of if (Lmodif == 1)
581
582!-----------------------------------------------------------------------
583!       Save some constants for later use (as routine arguments)
584!-----------------------------------------------------------------------
585      p_omeg = omeg
586      p_g = g
587      p_cpp = cpp
588      p_mugaz = mugaz
589      p_daysec = daysec
590      p_rad=rad
591
592
593      END SUBROUTINE tabfi
594
595
596      subroutine ini_tab_controle_dyn_xios(idayref)
597      ! Initialize controle variable for XIOS & diagfi
598
599        use comcstfi_mod,        only: g, mugaz, omeg, rad, rcp
600        use time_phylmdz_mod,  only: daysec, dtphys
601        use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, nbp_lev
602
603        implicit none
604
605        integer*4, intent(in) :: idayref ! date (initial date for this run)
606
607        integer :: length, l
608        parameter (length = 100)
609        real    :: tab_cntrl(length) ! run parameters are stored in this array
610
611        do l = 1,length
612            tab_cntrl(l) = 0.
613        enddo
614        tab_cntrl(1)  = real(nbp_lon)
615        tab_cntrl(2)  = real(nbp_lat-1)
616        tab_cntrl(3)  = real(nbp_lev)
617        tab_cntrl(4)  = real(idayref)
618        tab_cntrl(5)  = rad
619        tab_cntrl(6)  = omeg
620        tab_cntrl(7)  = g
621        tab_cntrl(8)  = mugaz
622        tab_cntrl(9)  = rcp
623        tab_cntrl(10) = daysec
624        tab_cntrl(11) = dtphys
625
626        tab_cntrl_mod = tab_cntrl
627
628      end subroutine ini_tab_controle_dyn_xios
629
630
631end module tabfi_mod
Note: See TracBrowser for help on using the repository browser.