source: trunk/LMDZ.COMMON/libf/evolution/conf_pem.F90 @ 3023

Last change on this file since 3023 was 3002, checked in by llange, 19 months ago

MARS PEM

  • Fix a bug in conf_pem ("Flux_geo" was expected in the .def while it should be 'fluxgeo', corrected)
  • Fix a bug in glaciers modules (the length for 'name_ice' was too large)
  • Fix a bug when writing tsoil in the PEM (ngrid x nsoil_PEM x nslope was given, while it was expecting a ngrid x nsoil_GCM x nslope)

PEM runs correctly now
LL

File size: 4.2 KB
RevLine 
[2859]1MODULE conf_pem_mod
2
[2980]3!=======================================================================
4!
5! Purpose: Read the parameter for a PEM run in run_pem.def
6!
7! Author: RV
8!=======================================================================
9
[2864]10IMPLICIT NONE
[2859]11
[2864]12CONTAINS
[2859]13
[2864]14  SUBROUTINE conf_pem
[2859]15
[2864]16#ifdef CPP_IOIPSL
17  use IOIPSL, only: getin
18#else
19  ! if not using IOIPSL, we still need to use (a local version of) getin
20  use ioipsl_getincom, only: getin
21#endif
22 
[2893]23  USE temps_mod_evol, ONLY: year_bp_ini, dt_pem, water_ice_criterion, co2_ice_criterion, ps_criterion, &
[2895]24                Max_iter_pem, evol_orbit_pem, var_obl, var_ex, var_lsp
25  USE comsoil_h_pem, only: soil_pem,fluxgeo,water_reservoir_nom,depth_breccia,depth_bedrock,reg_thprop_dependp
[2888]26  USE adsorption_mod,only: adsorption_pem
[2995]27  USE glaciers_mod, only: co2glaciersflow,h2oglaciersflow
[2961]28  use ice_table_mod, only: icetable_equilibrium, icetable_dynamic
[2918]29
[2888]30  CHARACTER(len=20),parameter :: modname ='conf_pem'
[2893]31
[2918]32!PEM parameters
[2893]33
[2963]34! #---------- ORBITAL parameters --------------#
[2918]35
[2963]36  evol_orbit_pem=.false.
37  CALL getin('evol_orbit_pem', evol_orbit_pem)
[2918]38
[2864]39  year_bp_ini=0.
40  CALL getin('year_bp_ini', year_bp_ini)
[2859]41
[2963]42  var_obl = .true.
43  CALL getin('var_obl',var_obl)
44  print*,'Does obliquity vary ?',var_obl
[2859]45
[2963]46  var_ex = .true.
47  CALL getin('var_ex',var_ex)
48  print*,'Does excentricity vary ?',var_ex
49
50  var_lsp = .true.
51  CALL getin('var_lsp',var_lsp)
52  print*,'Does Ls peri vary ?',var_lsp
53
54! #---------- Stopping criterion parameters --------------#
55
56  Max_iter_pem=99999999
57  CALL getin('Max_iter_pem', Max_iter_pem)
58
[2893]59  water_ice_criterion=0.2
60  CALL getin('water_ice_criterion', water_ice_criterion)
[2859]61
[2893]62  co2_ice_criterion=0.2
63  CALL getin('co2_ice_criterion', co2_ice_criterion)
64
[2888]65  ps_criterion = 0.15
66  CALL getin('ps_criterion',ps_criterion)
67
[2963]68  dt_pem=1
69  CALL getin('dt_pem', dt_pem)
[2859]70
[2963]71! #---------- Subsurface parameters --------------#
[2859]72
[2864]73  soil_pem=.true.
74  CALL getin('soil_pem', soil_pem)
[2859]75
[2888]76  adsorption_pem = .true.
77  CALL getin('adsorption_pem',adsorption_pem)
78
[2963]79  co2glaciersflow = .true.
80  CALL getin('co2glaciersflow', co2glaciersflow)
81
[2995]82  h2oglaciersflow = .true.
83  CALL getin('h2oglaciersflow', h2oglaciersflow)
84
[2963]85  reg_thprop_dependp = .false.
86  CALL getin('reg_thprop_dependp',reg_thprop_dependp)
87  print*, 'Thermal properties of the regolith vary with pressure ?', reg_thprop_dependp
88
89! #---------- Layering parameters --------------#
90
[2888]91  fluxgeo = 0.
[3002]92  CALL getin('fluxgeo',fluxgeo)
[2888]93  print*,'Flux Geothermal is set to',fluxgeo
[2895]94   
95  depth_breccia   = 10.
96  CALL getin('depth_breccia',depth_breccia)
97  print*,'Depth of breccia is set to',depth_breccia
[2894]98
[2895]99  depth_bedrock   = 1000.
100  CALL getin('depth_bedrock',depth_bedrock)
101  print*,'Depth of bedrock is set to',depth_bedrock
102
[2961]103   icetable_equilibrium = .true.
104   CALL getin('icetable_equilibrium',icetable_equilibrium)
105   print*, 'Do we compute the ice table at equilibrium?', icetable_equilibrium
[2895]106
[2961]107   icetable_dynamic = .false.
108   CALL getin('icetable_dynamic',icetable_dynamic)
109   print*, 'Do we compute the ice table with the dynamic method?', icetable_dynamic
[2982]110  if ((.not.soil_pem).and.((icetable_equilibrium).or.(icetable_dynamic))) then
[2961]111       print*,'Ice table  must be used when soil_pem = T'
112       call abort_physic(modname,"Ice table  must be used when soil_pem = T",1)
113  endif
114
[2982]115  if ((.not.soil_pem).and.adsorption_pem) then
[2888]116       print*,'Adsorption must be used when soil_pem = T'
117       call abort_physic(modname,"Adsorption must be used when soil_pem = T",1)
[2893]118  endif
[2888]119 
[2982]120  if ((.not.soil_pem).and.(fluxgeo.gt.0.)) then
[2888]121       print*,'Soil is not activated but Flux Geo > 0.'
[2895]122       call abort_physic(modname,"Soil is not activated but Flux Geo > 0.",1)
[2893]123  endif
[2895]124 
[2982]125  if ((.not.soil_pem).and.reg_thprop_dependp) then
[2895]126     print*,'Regolith properties vary with Ps only when soil is set to true'
127     call abort_physic(modname,'Regolith properties vary with Ps only when soil is set to true',1)
128  endif
[2894]129
130  if (evol_orbit_pem.and.year_bp_ini.eq.0.) then
[2895]131     print*,'You want to follow the file ob_ex_lsp.asc for changing orb parameters,'
132     print*,'but you did not specify from which year to start.'
133     call abort_physic(modname,"evol_orbit_pem=.true. but year_bp_ini=0",1)
134  endif
135
136  water_reservoir_nom = 1e4
[2888]137  CALL getin('water_reservoir_nom',water_reservoir_nom)
[2895]138
[2864]139  END SUBROUTINE conf_pem
[2859]140
141END MODULE conf_pem_mod
Note: See TracBrowser for help on using the repository browser.