Changeset 3065 for trunk/LMDZ.MARS/libf


Ignore:
Timestamp:
Oct 2, 2023, 2:30:47 PM (22 months ago)
Author:
jbclement
Message:

PEM:
Initialization of the PEM in 1D through the subroutine "init_testphys1d_mod.F90" + Some adaptations of the Mars PCM in 1D + Update of "launch_pem.sh" in deftank.
JBC

Location:
trunk/LMDZ.MARS/libf/phymars/dyn1d
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/LMDZ.MARS/libf/phymars/dyn1d/init_testphys1d_mod.F90

    r3060 r3065  
    55contains
    66
    7 SUBROUTINE init_testphys1d(startfiles_1D,therestart1D,therestartfi,ngrid,nlayer,odpref,nq,ndt,ptif,pks,dttestphys, &
    8                            q,zqsat,qsurf,dq,dqdyn,day0,day,time,psurf,tsurf,gru,grv,u,v,w,q2,play,plev,tsoil,temp, &
     7SUBROUTINE init_testphys1d(pem1d,ngrid,nlayer,odpref,nq,q,time,psurf,u,v,temp,startfiles_1D,therestart1D,therestartfi, &
     8                           ndt,ptif,pks,dttestphys,zqsat,qsurf,dq,dqdyn,day0,day,tsurf,gru,grv,w,q2,play,plev,tsoil,  &
    99                           albedo,emis,latitude,longitude,cell_area,atm_wat_profile,atm_wat_tau)
    1010
     
    4747! Arguments
    4848!=======================================================================
    49 logical, intent(in) :: startfiles_1D, therestart1D, therestartfi ! Use of "start1D.txt" and "startfi.nc" files
    50 integer, intent(in) :: ngrid, nlayer
    51 real,    intent(in) :: odpref ! DOD reference pressure (Pa)
     49integer,            intent(in) :: ngrid, nlayer
     50real,               intent(in) :: odpref        ! DOD reference pressure (Pa)
     51logical,            intent(in) :: pem1d         ! If initialization for the 1D PEM
    5252
    5353integer, intent(inout) :: nq
    5454
     55real, dimension(:,:), allocatable, intent(out) :: q     ! tracer mixing ratio (e.g. kg/kg)
     56real,                              intent(out) :: time  ! time (0<time<1; time=0.5 at noon)
     57real,                              intent(out) :: psurf ! Surface pressure
     58real, dimension(nlayer),           intent(out) :: u, v  ! zonal, meridional wind
     59real, dimension(nlayer),           intent(out) :: temp  ! temperature at the middle of the layers
     60logical,                           intent(out) :: startfiles_1D, therestart1D, therestartfi ! Use of starting files for 1D
    5561integer,                           intent(out) :: ndt
    5662real,                              intent(out) :: ptif, pks
    57 real,                              intent(out) :: dttestphys    ! testphys1d timestep
    58 real, dimension(:,:), allocatable, intent(out) :: q             ! tracer mixing ratio (e.g. kg/kg)
    59 real, dimension(:),   allocatable, intent(out) :: zqsat         ! useful for (atm_wat_profile=2)
    60 real, dimension(:),   allocatable, intent(out) :: qsurf         ! tracer surface budget (e.g. kg.m-2)
    61 real, dimension(:,:), allocatable, intent(out) :: dq, dqdyn     ! Physical and dynamical tandencies
    62 integer,                           intent(out) :: day0          ! initial (sol ; =0 at Ls=0) and final date
    63 real,                              intent(out) :: day           ! date during the run
    64 real,                              intent(out) :: time          ! time (0<time<1; time=0.5 at noon)
    65 real,                              intent(out) :: psurf         ! Surface pressure
    66 real, dimension(1),                intent(out) :: tsurf         ! Surface temperature
    67 real,                              intent(out) :: gru, grv      ! prescribed "geostrophic" background wind
    68 real, dimension(nlayer),           intent(out) :: u, v, w       ! zonal, meridional wind
    69 real, dimension(nlayer + 1),       intent(out) :: q2            ! Turbulent Kinetic Energy
    70 real, dimension(nlayer),           intent(out) :: play          ! Pressure at the middle of the layers (Pa)
    71 real, dimension(nlayer + 1),       intent(out) :: plev          ! intermediate pressure levels (pa)
    72 real, dimension(nsoilmx),          intent(out) :: tsoil         ! subsurface soil temperature (K)
    73 real, dimension(nlayer),           intent(out) :: temp          ! temperature at the middle of the layers
    74 real, dimension(1,1),              intent(out) :: albedo        ! surface albedo
    75 real, dimension(1),                intent(out) :: emis          ! surface layer
     63real,                              intent(out) :: dttestphys                   ! testphys1d timestep
     64real, dimension(:),   allocatable, intent(out) :: zqsat                        ! useful for (atm_wat_profile=2)
     65real, dimension(:),   allocatable, intent(out) :: qsurf                        ! tracer surface budget (e.g. kg.m-2)
     66real, dimension(:,:), allocatable, intent(out) :: dq, dqdyn                    ! Physical and dynamical tandencies
     67integer,                           intent(out) :: day0                         ! initial (sol ; =0 at Ls=0) and final date
     68real,                              intent(out) :: day                          ! date during the run
     69real, dimension(1),                intent(out) :: tsurf                        ! Surface temperature
     70real,                              intent(out) :: gru, grv                     ! prescribed "geostrophic" background wind
     71real, dimension(nlayer),           intent(out) :: w                            ! "Dummy wind" in 1D
     72real, dimension(nlayer + 1),       intent(out) :: q2                           ! Turbulent Kinetic Energy
     73real, dimension(nlayer),           intent(out) :: play                         ! Pressure at the middle of the layers (Pa)
     74real, dimension(nlayer + 1),       intent(out) :: plev                         ! intermediate pressure levels (pa)
     75real, dimension(nsoilmx),          intent(out) :: tsoil                        ! subsurface soil temperature (K)
     76real, dimension(1,1),              intent(out) :: albedo                       ! surface albedo
     77real, dimension(1),                intent(out) :: emis                         ! surface layer
    7678real, dimension(1),                intent(out) :: latitude, longitude, cell_area
    77 real,                              intent(out) :: atm_wat_profile, atm_wat_tau
     79real,                              intent(out) :: atm_wat_profile, atm_wat_tau ! Force atmospheric water profiles
    7880
    7981!=======================================================================
     
    8991real, dimension(:,:),     allocatable :: psdyn
    9092
    91 ! RV & JBC: Use of "start1D.txt" and "startfi.nc" files
     93! RV & JBC: Use of starting files for 1D
    9294logical                :: found
    9395character(len = 30)    :: header
     
    102104integer                                        :: ifils, ipere, generation, ierr0
    103105character(len = 30), dimension(:), allocatable :: tnom_transp ! transporting fluid short name
    104 character(len = 80)                            :: line ! to store a line of text
     106character(len = 80)                            :: line        ! to store a line of text
    105107logical                                        :: continu, there
    106108
     
    113115real :: flux_geo_tmp
    114116
     117! JBC: To initialize the 1D PEM
     118character(:), allocatable :: start1Dname, startfiname ! Name of starting files for 1D
     119
    115120!=======================================================================
    116121! Code
    117122!=======================================================================
     123if (.not. pem1d) then
     124    start1Dname = 'start1D.txt'
     125    startfiname = 'startfi.nc'
     126    startfiles_1D = .false.
     127    !------------------------------------------------------
     128    ! Loading run parameters from "run.def" file
     129    !------------------------------------------------------
     130    ! check if 'run.def' file is around. Otherwise reading parameters
     131    ! from callphys.def via getin() routine won't work.
     132    inquire(file = 'run.def',exist = there)
     133    if (.not. there) then
     134        write(*,*) 'Cannot find required file "run.def"'
     135        write(*,*) '  (which should contain some input parameters along with the following line: INCLUDEDEF=callphys.def)'
     136        write(*,*) ' ... might as well stop here ...'
     137        stop
     138    endif
     139
     140    write(*,*)'Do you want to use starting files?'
     141    call getin("startfiles_1D",startfiles_1D)
     142    write(*,*) " startfiles_1D = ", startfiles_1D
     143else
     144    start1dname = 'start1D_evol.txt'
     145    startfiname = 'startfi_evol.nc'
     146    startfiles_1D = .true.
     147endif
     148
     149therestart1D = .false.
     150therestartfi = .false.
     151inquire(file = start1Dname,exist = therestart1D)
     152if (startfiles_1D .and. .not. therestart1D) then
     153    write(*,*) 'There is no "'//start1Dname//'" file!'
     154    if (.not. pem1d) then
     155        write(*,*) 'Initialization is done with default values.'
     156    else
     157        write(*,*) 'Initialization cannot be done for the 1D PEM.'
     158        stop
     159    endif
     160endif
     161inquire(file = startfiname,exist = therestartfi)
     162if (.not. therestartfi) then
     163    write(*,*) 'There is no "'//startfiname//'" file!'
     164    if (.not. pem1d) then
     165        write(*,*) 'Initialization is done with default values.'
     166    else
     167        write(*,*) 'Initialization cannot be done for the 1D PEM.'
     168        stop
     169    endif
     170endif
    118171
    119172!------------------------------------------------------
     
    186239    endif
    187240endif
     241
    188242! allocate arrays:
    189243allocate(tname(nq),q(nlayer,nq),zqsat(nlayer),qsurf(nq))
     
    245299else
    246300    do iq = 1,nq
    247         open(3,file = 'start1D.txt',status = "old",action = "read")
     301        open(3,file = start1Dname,status = "old",action = "read")
    248302        read(3,*) header, qsurf(iq),(q(ilayer,iq), ilayer = 1,nlayer)
    249303        if (trim(tname(iq)) /= trim(header)) then
    250             write(*,*) 'Tracer names not compatible for initialization with "start1D.txt"!'
     304            write(*,*) 'Tracer names not compatible for initialization with "'//trim(start1Dname)//'"!'
    251305            stop
    252306        endif
     
    254308endif
    255309
    256 call init_physics_distribution(regular_lonlat,4,1,1,1,nlayer,COMM_LMDZ)
     310#ifdef CPP_XIOS
     311    call init_physics_distribution(regular_lonlat,4,1,1,1,nlayer,COMM_LMDZ)
     312#else
     313    call init_physics_distribution(regular_lonlat,4,1,1,1,nlayer,1)
     314#endif
    257315
    258316! Date and local time at beginning of run
     
    261319    ! Date (in sols since spring solstice) at beginning of run
    262320    day0 = 0 ! default value for day0
    263     write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
     321    write(*,*) 'Initial date (in martian sols; =0 at Ls=0)?'
    264322    call getin("day0",day0)
    265323    day = float(day0)
     
    272330    time = time/24. ! convert time (hours) to fraction of sol
    273331else
    274     call open_startphy("startfi.nc")
     332    call open_startphy(startfiname)
    275333    call get_var("controle",tab_cntrl,found)
    276334    if (.not. found) then
     
    545603zlay(:) = -200.*r*log(play(:)/plev(1))/g
    546604
    547 
    548605! Initialize temperature profile
    549606! ------------------------------
  • trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F90

    r3060 r3065  
    11PROGRAM testphys1d
    22
    3 use ioipsl_getincom,         only: getin ! To use 'getin'
    43use comsoil_h,               only: inertiedat, inertiesoil, nsoilmx
    54use surfdat_h,               only: albedodat, perenial_co2ice, watercap
     
    10099character(len = 44)     :: txt
    101100
    102 ! RV & JBC: Use of "start1D.txt" and "startfi.nc" files
     101! RV & JBC: Use of starting files for 1D
    103102logical :: startfiles_1D, therestart1D, therestartfi
    104103
     
    121120!call initcomgeomphy
    122121
    123 !------------------------------------------------------
    124 ! Loading run parameters from "run.def" file
    125 !------------------------------------------------------
    126 ! check if 'run.def' file is around. Otherwise reading parameters
    127 ! from callphys.def via getin() routine won't work.
    128 inquire(file = 'run.def',exist = there)
    129 if (.not. there) then
    130     write(*,*) 'Cannot find required file "run.def"'
    131     write(*,*) '  (which should contain some input parameters along with the following line: INCLUDEDEF=callphys.def)'
    132     write(*,*) ' ... might as well stop here ...'
    133     stop
    134 endif
    135 
    136 write(*,*)'Do you want to use "start1D.txt" and "startfi.nc" files?'
    137 startfiles_1D = .false.
    138 therestart1D = .false.
    139 therestartfi = .false.
    140 call getin("startfiles_1D",startfiles_1D)
    141 write(*,*) " startfiles_1D = ", startfiles_1D
    142 
    143 if (startfiles_1D) then
    144     inquire(file = 'start1D.txt',exist = therestart1D)
    145     if (.not. therestart1D) then
    146         write(*,*) 'There is no "start1D.txt" file!'
    147         write(*,*) 'Initialization is done with default values.'
    148     endif
    149     inquire(file = 'startfi.nc',exist = therestartfi)
    150     if (.not. therestartfi) then
    151         write(*,*) 'There is no "startfi.nc" file!'
    152         write(*,*) 'Initialization is done with default values.'
    153     endif
    154 endif
    155 
    156 call init_testphys1d(startfiles_1D,therestart1D,therestartfi,ngrid,nlayer,odpref,nq,ndt,ptif,pks,dttestphys, &
    157                      q,zqsat,qsurf,dq,dqdyn,day0,day,time,psurf,tsurf,gru,grv,u,v,w,q2,play,plev,tsoil,temp, &
     122call init_testphys1d(.false.,ngrid,nlayer,odpref,nq,q,time,psurf,u,v,temp,startfiles_1D,therestart1D,therestartfi, &
     123                     ndt,ptif,pks,dttestphys,zqsat,qsurf,dq,dqdyn,day0,day,tsurf,gru,grv,w,q2,play,plev,tsoil,     &
    158124                     albedo,emis,latitude,longitude,cell_area,atm_wat_profile,atm_wat_tau)
    159125
     
    265231
    266232! Writing the "restart1D.txt" file for the next run
    267 if (startfiles_1D) call writerestart1D(psurf,tsurf,nlayer,temp,u,v,nq,noms,qsurf,q)
     233if (startfiles_1D) call writerestart1D('restart1D.txt',psurf,tsurf,nlayer,temp,u,v,nq,noms,qsurf,q)
    268234
    269235write(*,*) "testphys1d: everything is cool."
  • trunk/LMDZ.MARS/libf/phymars/dyn1d/writerestart1D.F90

    r3051 r3065  
    1 SUBROUTINE writerestart1D(psurf,tsurf,nlayer,temp,u,v,nq,qnames,qsurf,q)
     1SUBROUTINE writerestart1D(filename,psurf,tsurf,nlayer,temp,u,v,nq,qnames,qsurf,q)
    22
    33implicit none
    44
    55! Arguments
    6 integer, intent(in)                           :: nlayer, nq
    7 real, intent(in)                              :: psurf, tsurf
    8 real, dimension(nlayer), intent(in)           :: temp, u, v
    9 real, dimension(nlayer,nq), intent(in)        :: q
    10 real, dimension(nq), intent(in)               :: qsurf
     6character(len = *),                intent(in) :: filename
     7integer,                           intent(in) :: nlayer, nq
     8real,                              intent(in) :: psurf, tsurf
     9real, dimension(nlayer),           intent(in) :: temp, u, v
     10real, dimension(nlayer,nq),        intent(in) :: q
     11real, dimension(nq),               intent(in) :: qsurf
    1112character(len = *), dimension(nq), intent(in) :: qnames
    1213
     
    1516
    1617! Write the data needed for a restart in "restart1D.txt"
    17 open(1,file = 'restart1D.txt',status = "replace",action = "write")
     18open(1,file = filename,status = "replace",action = "write")
    1819do iq = 1,nq
    1920    write(1,*) qnames(iq), qsurf(iq), (q(il,iq), il = 1,nlayer)
Note: See TracChangeset for help on using the changeset viewer.