Changeset 3836


Ignore:
Timestamp:
Jul 7, 2025, 2:46:43 PM (3 days ago)
Author:
jbclement
Message:

COMMON:
Rework related to the command-line parsing:

  • Replace ad-hoc argument parsing with a unified 'parse_args' subroutine, allowing easier extension to other programs and options across models;;
  • Use of '--version' (with ab optional output file) to print compilation/version details;
  • Addition of 'job_timelimit_mod' module to handle SLURM/PBS job time-limit via '--jobid' (currently only used in the PEM), allowing easier extension to other programs;
  • Replace manual SSO handling with 'parse_args' for the Mars start2archive;
  • Clean-up related legacy code in the programs supporting the version option.

JBC

Location:
trunk
Files:
12 edited

Legend:

Unmodified
Added
Removed
  • trunk/LMDZ.COMMON/libf/dyn3d/gcm.F90

    r3615 r3836  
    3030  USE temps_mod, ONLY: calend,start_time,annee_ref,day_ref, &
    3131                itau_dyn,itau_phy,day_ini,jD_ref,jH_ref,day_end
    32   use version_info_mod, only: print_version_info
     32  use parse_args_mod, only: parse_args
    3333
    3434
     
    134134  character (len=20) :: modname
    135135  character (len=80) :: abort_message
    136   character(100)     :: arg ! To read command-line arguments
    137136  ! locales pour gestion du temps
    138137  INTEGER :: an, mois, jour
     
    144143!   Initialisations:
    145144!   ----------------
    146 
    147   if (command_argument_count() > 0) then ! Get the number of command-line arguments
    148       call get_command_argument(1,arg) ! Read the argument given to the program
    149       select case (trim(adjustl(arg)))
    150           case('version')
    151               call print_version_info()
    152               stop
    153           case default
    154               error stop "The argument given to the program is unknown!"
    155       end select
    156   endif
     145  ! Parse command-line options
     146  call parse_args()
    157147
    158148  abort_message = 'last timestep reached'
  • trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F

    r3615 r3836  
    2727     &                       ecritstart
    2828      use cpdet_mod, only: ini_cpdet
    29       use version_info_mod, only: print_version_info
     29      use parse_args_mod, only: parse_args
    3030
    3131
     
    135135      character (len=20) :: modname
    136136      character (len=80) :: abort_message
    137       character(100)     :: arg ! To read command-line arguments
    138137! locales pour gestion du temps
    139138      INTEGER :: an, mois, jour
     
    158157c   Initialisations:
    159158c   ----------------
    160 
    161       if (command_argument_count() > 0) then ! Get the number of command-line arguments
    162           call get_command_argument(1,arg) ! Read the argument given to the program
    163           select case (trim(adjustl(arg)))
    164               case('version')
    165                   call print_version_info()
    166                   stop
    167               case default
    168                   error stop 'The argument given to the program is '
    169      &//'unknown!'
    170           end select
    171       endif
     159      ! Parse command-line options
     160      call parse_args()
    172161
    173162      abort_message = 'last timestep reached'
  • trunk/LMDZ.COMMON/libf/evolution/pem.F90

    r3809 r3836  
    7373                                      print_layering
    7474use dyn_ss_ice_m_mod,           only: dyn_ss_ice_m
    75 use version_info_mod,           only: print_version_info
     75use parse_args_mod,             only: parse_args
     76use job_timelimit_mod,          only: timelimit, antetime, timewall
    7677use paleoclimate_mod,           only: h2o_ice_depth, zdqsdif_ssi_tot
    7778
     
    241242real                  :: n_myear         ! Maximum number of Martian years of the chained simulations
    242243real                  :: timestep        ! Timestep [s]
    243 character(100)        :: arg             ! To read command-line arguments program was invoked
    244 logical               :: timewall        ! Flag to use the time limit stopping criterion in case of a PEM job
    245244integer(kind = 8)     :: cr              ! Number of clock ticks per second (count rate)
    246245integer(kind = 8)     :: c1, c2          ! Counts of processor clock
    247 character(100)        :: chtimelimit     ! Time limit for the PEM job outputted by the SLURM command
    248 real                  :: timelimit       ! Time limit for the PEM job in seconds
    249 real, parameter       :: antetime = 3600 ! Anticipation time to prevent reaching the job time limit: 3600 s by default (it should cover the computing time of the reshaping tool)
    250 integer               :: cstat, days, hours, minutes, seconds
    251 character(1)          :: sep
    252246character(8)          :: date
    253247character(10)         :: time
     
    313307call system_clock(count_rate = cr)
    314308call system_clock(c1)
    315 timewall = .true.
    316 timelimit = 86400 ! 86400 seconds = 24 h by default
    317 if (command_argument_count() > 0) then ! Get the number of command-line arguments
    318     call get_command_argument(1,arg) ! Read the argument given to the program
    319     num_str = .true.
    320     do i = 1,len_trim(arg)
    321         if (arg(i:i) < '0' .or. arg(i:i) > '9') then
    322             num_str = .false.
    323             exit
    324         endif
    325     enddo
    326 
    327     if (num_str) then ! This is a numeric sting so we considerer this is the job id
    328            ! Execute the system command
    329             call execute_command_line('squeue -j '//trim(adjustl(arg))//' -h --Format TimeLimit > tmp_cmdout.txt',cmdstat = cstat)
    330             if (cstat /= 0) then
    331                 call execute_command_line('qstat -f '//trim(adjustl(arg))//' | grep "Walltime" | awk ''{print $3}'' > tmp_cmdout.txt',cmdstat = cstat)
    332                 if (cstat > 0) then
    333                     error stop 'pem: command execution failed!'
    334                 else if (cstat < 0) then
    335                     error stop 'pem: command execution not supported (neither SLURM nor PBS/TORQUE is installed)!'
    336                 endif
    337             endif
    338             ! Read the output
    339             open(1,file = 'tmp_cmdout.txt',status = 'old')
    340             read(1,'(a)') chtimelimit
    341             close(1)
    342             chtimelimit = trim(adjustl(chtimelimit))
    343             call execute_command_line('rm tmp_cmdout.txt',cmdstat = cstat)
    344             if (cstat > 0) then
    345                 error stop 'pem: command execution failed!'
    346             else if (cstat < 0) then
    347                 error stop 'pem: command execution not supported!'
    348             endif
    349             if (index(chtimelimit,'-') > 0) then ! 'chtimelimit' format is "D-HH:MM:SS"
    350                 read(chtimelimit,'(i1,a1,i2,a1,i2,a1,i2)') days, sep, hours, sep, minutes, sep, seconds
    351                 timelimit = days*86400 + hours*3600 + minutes*60 + seconds
    352             else if (index(chtimelimit,':') > 0 .and. len_trim(chtimelimit) > 5) then ! 'chtimelimit' format is "HH:MM:SS"
    353                 read(chtimelimit,'(i2,a1,i2,a1,i2)') hours, sep, minutes, sep, seconds
    354                 timelimit = hours*3600 + minutes*60 + seconds
    355             else ! 'chtimelimit' format is "MM:SS"
    356                 read(chtimelimit,'(i2,a1,i2)') minutes, sep, seconds
    357                 timelimit = minutes*60 + seconds
    358             endif
    359     else ! Arg is not a numeric string
    360         select case (trim(adjustl(arg)))
    361             case('version') ! Handle command‐line argument "version"
    362                 call print_version_info()
    363                 stop
    364             case default
    365                 error stop "The argument given to the program is unknown!"
    366         end select
    367     endif
    368 else
    369     timewall = .false.
    370 endif
     309call parse_args()
    371310
    372311! Some user info
  • trunk/LMDZ.COMMON/libf/evolution/reshape_XIOS_output.F90

    r3786 r3836  
    1111
    1212use netcdf
    13 use version_info_mod, only: print_version_info
     13use parse_args_mod, only: parse_args
    1414
    1515implicit none
     
    3939integer                            :: i, j, k
    4040integer                            :: numDimsVar, numAttsVar
    41 character(100)                     :: varName, arg
     41character(100)                     :: varName
    4242integer                            :: xtypeVar
    4343integer, allocatable, dimension(:) :: dimids_var_in
     
    7272
    7373! CODE
    74 ! Handle command‐line argument "version"
    75 if (command_argument_count() > 0) then ! Get the number of command-line arguments
    76     call get_command_argument(1,arg) ! Read the argument given to the program
    77     select case (trim(adjustl(arg)))
    78         case('version')
    79             call print_version_info()
    80             stop
    81         case default
    82             error stop 'The argument given to the program is unknown!'
    83     end select
    84 endif
     74! Parse command-line options
     75call parse_args()
    8576
    8677! Main loop: two PCM years
  • trunk/LMDZ.COMMON/makelmdz_fcm

    r3830 r3836  
    603603
    604604# Path and name of the generated file
    605 info_file="$LIBFGCM/misc/version_info.F90"
    606 
    607 # Path and name of the file containing the difference result
    608 res_file="pgrm_version_details.txt"
     605version_F90file="$LIBFGCM/misc/pgrm_version.F90"
     606
     607# Path and name of the file containing the compilation and version details
     608default_out_file="pgrm_version_details.txt"
    609609
    610610# Get the current date
     
    653653
    654654# Generate the Fortran subroutine
    655 cat << EOF > "$info_file"
     655cat << EOF > "$version_F90file"
     656MODULE pgrm_version_mod
     657
    656658!***********************************************************************
    657659! File generated automatically at compilation
    658660!
    659661! DESCRIPTION:
    660 !    The subroutine 'print_version_info' prints compilation details, the
    661 !    version control information (SVN or Git), the status and the diff
    662 !    result if applicable.
     662!    The subroutine 'print_pgrm_version' prints compilation details, the version
     663!    control information (SVN or Git), the status and the diff result if applicable.
    663664!
    664665! PARAMETERS:
     
    666667!
    667668! USAGE:
    668 !    Put the argument 'version' as an option when executing the code to
    669 !    display compilation and version details. It is useful for tracking
    670 !    code builds through the executable file.
     669!    Use the command-line option "--version [file]" when running your program:
     670!       ./myprogram --version [file]
     671!    This will write compilation and version details into the specified [file].
     672!    If [file] is omitted, the default name "pgrm_version_details.txt" will be used.
     673!    This feature helps track code builds and their exact compilation context
     674!    directly from the executable.
    671675!***********************************************************************
    672676
    673 MODULE version_info_mod
     677implicit none
     678
     679character(*), parameter :: default_out_file = "${default_out_file}"
    674680
    675681!=======================================================================
     
    677683!=======================================================================
    678684
    679 SUBROUTINE print_version_info()
    680 
    681 integer, parameter :: io_unit = 10
    682 
    683 open(io_unit, file = '${res_file}',status = 'replace',action = 'write')
    684 
    685 write(*,'(a)') '-> Writing compilation details to the file "${res_file}".'
     685SUBROUTINE print_pgrm_version(user_out_file)
     686
     687!---- Arguments
     688character(*), optional, intent(in) :: user_out_file
     689
     690!---- Variables
     691integer, parameter        :: io_unit = 10
     692character(:), allocatable :: out_file
     693
     694!---- Code
     695if (present(user_out_file)) then
     696    out_file = trim(adjustl(user_out_file))
     697else
     698    out_file = trim(adjustl(default_out_file))
     699endif
     700
     701open(io_unit,file = out_file,status = 'replace',action = 'write')
     702
     703write(*,*)
     704write(*,'(a)') '-> Writing compilation details to the file "'//out_file//'".'
    686705write(io_unit,'(a)') '========================= COMPILATION DETAILS =========================='
    687 write(io_unit,'(a)') '-> Date: ${current_date}'
     706write(io_unit,'(a)') '-> Date   : ${current_date}'
    688707write(io_unit,'(a)') '-> Command: ${compilation_command}'
    689708write(io_unit,*)
     
    691710
    692711if [ -n "$vcs_info" ]; then
    693     echo "write(*,'(a)') '-> Writing information result to the file \"${res_file}\".'" >> "$info_file"
    694     echo "write(io_unit,'(a)') '===================== VERSION CONTROL INFORMATION ======================'" >> "$info_file"
     712    echo "write(*,'(a)') '-> Writing information result to the file \"'//out_file//'\".'" >> "$version_F90file"
     713    echo "write(io_unit,'(a)') '===================== VERSION CONTROL INFORMATION ======================'" >> "$version_F90file"
    695714    while IFS= read -r line; do
    696         echo "write(io_unit,'(a)') '${line}'" >> "$info_file"
     715        echo "write(io_unit,'(a)') '${line}'" >> "$version_F90file"
    697716    done <<< "$(echo -e "$vcs_info")"
    698717else
    699     echo "write(io_unit,'(a)') '====================== NO VERSION CONTROL SYSTEM ======================='" >> "$info_file"
     718    echo "write(io_unit,'(a)') '====================== NO VERSION CONTROL SYSTEM ======================='" >> "$version_F90file"
    700719fi
    701720
    702721if [ -n "$vcs_stat" ]; then
    703     echo "write(*,'(a)') '-> Writing status result to the file \"${res_file}\".'" >> "$info_file"
    704     echo "write(io_unit,*)" >> "$info_file"
    705     echo "write(io_unit,'(a)') '======================== VERSION CONTROL STATUS ========================'" >> "$info_file"
     722    echo "write(*,'(a)') '-> Writing status result to the file \"'//out_file//'\".'" >> "$version_F90file"
     723    echo "write(io_unit,*)" >> "$version_F90file"
     724    echo "write(io_unit,'(a)') '======================== VERSION CONTROL STATUS ========================'" >> "$version_F90file"
    706725    while IFS= read -r line; do
    707         echo "write(io_unit,'(a)') '${line}'" >> "$info_file"
     726        echo "write(io_unit,'(a)') '${line}'" >> "$version_F90file"
    708727    done <<< "$(echo -e "$vcs_stat")"
    709728fi
    710729
    711730if [ -n "$vcs_diff" ]; then
    712     echo "write(*,'(a)') '-> Writing diff result to the file \"${res_file}\".'" >> "$info_file"
    713     echo "write(io_unit,*)" >> "$info_file"
    714     echo "write(io_unit,'(a)') '========================= VERSION CONTROL DIFF ========================='" >> "$info_file"
     731    echo "write(*,'(a)') '-> Writing diff result to the file \"'//out_file//'\".'" >> "$version_F90file"
     732    echo "write(io_unit,*)" >> "$version_F90file"
     733    echo "write(io_unit,'(a)') '========================= VERSION CONTROL DIFF ========================='" >> "$version_F90file"
    715734    while IFS= read -r line; do
    716         echo "write(io_unit,'(a)') '${line}'" >> "$info_file"
     735        echo "write(io_unit,'(a)') '${line}'" >> "$version_F90file"
    717736    done <<< "$(echo -e "$vcs_diff")"
    718737fi
    719738
    720 cat << EOF >> "$info_file"
     739cat << EOF >> "$version_F90file"
    721740write(io_unit,'(a)') '========================================================================'
     741write(*,*)
    722742
    723743close(io_unit)
    724744
    725 END SUBROUTINE print_version_info
    726 
    727 END MODULE version_info_mod
     745END SUBROUTINE print_pgrm_version
     746
     747END MODULE pgrm_version_mod
    728748EOF
    729749
    730750# Termination message
    731 echo "'$info_file' has been generated successfully."
     751echo "'$version_F90file' has been generated successfully."
    732752
    733753
  • trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/newstart.F

    r3621 r3836  
    5050     &                         latitude,  ! latitudes (rad)                       
    5151     &                         cell_area ! physics grid area (m2)
    52       use version_info_mod, only: print_version_info
     52      use parse_args_mod, only: parse_args
    5353                       
    5454      implicit none
     
    192192
    193193
    194       if (command_argument_count() > 0) then ! Get the number of command-line arguments
    195           call get_command_argument(1,txt) ! Read the argument given to the program
    196           select case (trim(adjustl(txt)))
    197               case('version')
    198                   call print_version_info()
    199                   stop
    200               case default
    201                   error stop 'The argument given to the program is '
    202      &//'unknown!'
    203           end select
    204       endif
     194      ! Parse command-line options
     195      call parse_args()
    205196
    206197c sortie visu pour les champs dynamiques
  • trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/start2archive.F

    r3576 r3836  
    3939     &                          east_gwstress, west_gwstress
    4040      use exner_hyb_m, only: exner_hyb
    41       use version_info_mod, only: print_version_info
     41      use parse_args_mod, only: parse_args
    4242
    4343      implicit none
     
    148148c   Initialisations
    149149c-----------------------------------------------------------------------
    150       if (command_argument_count() > 0) then ! Get the number of command-line arguments
    151           call get_command_argument(1,txt) ! Read the argument given to the program
    152           select case (trim(adjustl(txt)))
    153               case('version')
    154                   call print_version_info()
    155                   stop
    156               case default
    157                   error stop 'The argument given to the program is '
    158      &//'unknown!'
    159           end select
    160       endif
     150      ! Parse command-line options
     151      call parse_args()
    161152
    162153      CALL defrun_new(99, .TRUE. )
  • trunk/LMDZ.GENERIC/libf/phystd/dyn1d/kcm1d.F90

    r3716 r3836  
    2222  use dimphy, only : init_dimphy
    2323  use gases_h, only: ngasmx
    24   use version_info_mod, only: print_version_info
     24  use parse_args_mod, only: parse_args
    2525
    2626  implicit none
     
    111111  integer :: k
    112112
    113   character(100) :: arg ! To read command-line arguments
    114113 
    115114  ! --------------
    116115  ! Initialisation
    117116  ! --------------
    118   if (command_argument_count() > 0) then ! Get the number of command-line arguments
    119       call get_command_argument(1,arg) ! Read the argument given to the program
    120       select case (trim(adjustl(arg)))
    121           case('version')
    122               call print_version_info()
    123               stop
    124           case default
    125               error stop 'The argument given to the program is unknown!'
    126       end select
    127   endif
     117  ! Parse command-line options
     118  call parse_args()
    128119
    129120  pi=2.E+0*asin(1.E+0)
  • trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F

    r3788 r3836  
    4343     &                  nf90_strerror,NF90_INQ_VARID, NF90_GET_VAR,
    4444     &                  NF90_CLOSE
    45       use version_info_mod, only: print_version_info
     45      use parse_args_mod, only: parse_args
    4646      !use inichim_1D_mod, only: inichim_1D
    4747      !use initracer_1D_mod, only: initracer_1D
     
    169169c INITIALISATION
    170170c=======================================================================
    171       if (command_argument_count() > 0) then ! Get the number of command-line arguments
    172           call get_command_argument(1,txt) ! Read the argument given to the program
    173           select case (trim(adjustl(txt)))
    174               case('version')
    175                   call print_version_info()
    176                   stop
    177               case default
    178                   error stop 'The argument given to the program is '
    179      &//'unknown!'
    180           end select
    181       endif
     171      ! Parse command-line options
     172      call parse_args()
    182173
    183174! check if 'rcm1d.def' file is around
  • trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/newstart.F

    r3604 r3836  
    6161     &             ini_paleoclimate_h, end_paleoclimate_h
    6262      use subslope_mola_mod, ONLY: subslope_mola
    63       use version_info_mod, only: print_version_info
     63      use parse_args_mod, only: parse_args
    6464     
    6565      implicit none
     
    213213
    214214
    215       if (command_argument_count() > 0) then ! Get the number of command-line arguments
    216           call get_command_argument(1,txt) ! Read the argument given to the program
    217           select case (trim(adjustl(txt)))
    218               case('version')
    219                   call print_version_info()
    220                   stop
    221               case default
    222                   error stop 'The argument given to the program is '
    223      &//'unknown!'
    224           end select
    225       endif
     215      ! Parse command-line options
     216      call parse_args()
    226217
    227218c sortie visu pour les champs dynamiques
  • trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive.F

    r3576 r3836  
    4141      USE surfdat_h, ONLY: phisfi, albedodat, z0, z0_default,
    4242     &    zmea, zstd, zsig, zgam, zthe, hmons, summit, base
    43       use version_info_mod, only: print_version_info
     43      use parse_args_mod, only: parse_args, add_sso_fields
    4444
    4545      implicit none
     
    117117      REAL baseS(ip1jmp1)
    118118
    119       logical :: add_sso_fields=.false. ! default, don't include SSO fields
    120 
    121119
    122120c Variables intermediaires : vent naturel, mais pas coord scalaire
     
    149147      INTEGER nid,nid1
    150148
    151 C get command line arguments
    152 C here we assume and check that if there is an argument #1 then
    153 C it should be --add-sso to signal adding SSO fileds to start_archive.nc
    154       CALL get_command_argument(1,txt,j,ierr)
    155       ! will return ierr==0 if there is an argument #1 to command line
    156       IF (ierr==0) THEN
    157         ! Check that argument is indeed "--add-sso" or signal the error
    158         IF (trim(txt)=="--add-sso") THEN
    159           add_sso_fields=.true.
    160           write(*,*) "SSO fields will be included in start_archive"
    161         ELSE IF (trim(txt) == 'version') then
    162             call print_version_info()
    163             stop
    164         ELSE
    165           write(*,*) "start2archive error: unexpected command line "//
    166      &    "argument: ",trim(txt)
    167           write(*,*) " (only --add-sso currently accepted)"
    168           write(*,*) "Might as well stop here."
    169           stop
    170         ENDIF
    171       ENDIF ! of IF (ierr==0)
     149      ! Parse command-line options
     150      ! Option "--add-sso" adds SSO fields to "start_archive.nc"
     151      call parse_args()
    172152
    173153c-----------------------------------------------------------------------
  • trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F90

    r3831 r3836  
    1818use init_testphys1d_mod, only: init_testphys1d
    1919use writerestart1D_mod,  only: writerestart1D
    20 ! Mostly for XIOS outputs:
     20use parse_args_mod,      only: parse_args
     21use callkeys_mod,        only: water
     22! Mostly for XIOS outputs
    2123use mod_const_mpi,       only: init_const_mpi
    2224use parallel_lmdz,       only: init_parallel
    23 use version_info_mod,    only: print_version_info
    24 use callkeys_mod, only: water
    2525
    2626implicit none
     
    6868real, dimension(:,:,:), allocatable :: q             ! tracer mixing ratio (e.g. kg/kg)
    6969real, dimension(1)                  :: wstar = 0.    ! Thermals vertical velocity
    70 character(100)                      :: arg           ! To read command-line arguments
    7170
    7271! Physical and dynamical tendencies (e.g. m.s-2, K/s, Pa/s)
     
    9493! INITIALISATION
    9594!=======================================================================
    96 if (command_argument_count() > 0) then ! Get the number of command-line arguments
    97     call get_command_argument(1,arg) ! Read the argument given to the program
    98     select case (trim(adjustl(arg)))
    99         case('version')
    100             call print_version_info()
    101             stop
    102         case default
    103             error stop 'The argument given to the program is unknown!'
    104     end select
    105 endif
     95! Parse command-line options
     96call parse_args()
    10697
    10798#ifdef CPP_XIOS
Note: See TracChangeset for help on using the changeset viewer.