Ignore:
Timestamp:
Jul 24, 2024, 4:39:59 PM (4 months ago)
Author:
abarral
Message:

Replace iniprint.h by lmdz_iniprint.f90
(lint) along the way

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90

    r5113 r5118  
    1 
    21! $Id$
    32
    … …  
    65CONTAINS
    76
    8 SUBROUTINE iniphysiq(ii,jj,nlayer, &
    9                      nbp, communicator, &
    10                      punjours, pdayref,ptimestep, &
    11                      rlatudyn,rlatvdyn,rlonudyn,rlonvdyn,airedyn,cudyn,cvdyn, &
    12                      prad,pg,pr,pcpp,iflag_phys)
    13   USE dimphy, ONLY: init_dimphy
    14   USE inigeomphy_mod, ONLY: inigeomphy
    15   USE lmdz_grid_phy, ONLY: nbp_lon,nbp_lat,nbp_lev,klon_glo ! number of atmospheric columns (on full grid)
    16   USE lmdz_phys_para, ONLY: klon_omp ! number of columns (on local omp grid)
    17   USE lmdz_vertical_layers, ONLY: init_vertical_layers
    18   USE infotrac, ONLY: nbtr, type_trac
     7  SUBROUTINE iniphysiq(ii, jj, nlayer, &
     8          nbp, communicator, &
     9          punjours, pdayref, ptimestep, &
     10          rlatudyn, rlatvdyn, rlonudyn, rlonvdyn, airedyn, cudyn, cvdyn, &
     11          prad, pg, pr, pcpp, iflag_phys)
     12    USE dimphy, ONLY: init_dimphy
     13    USE inigeomphy_mod, ONLY: inigeomphy
     14    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo ! number of atmospheric columns (on full grid)
     15    USE lmdz_phys_para, ONLY: klon_omp ! number of columns (on local omp grid)
     16    USE lmdz_vertical_layers, ONLY: init_vertical_layers
     17    USE infotrac, ONLY: nbtr, type_trac
    1918
    2019#ifdef REPROBUS
    … …  
    2625  USE lmdz_phys_omp_data, ONLY: klon_omp
    2726#endif
    28   USE control_mod, ONLY: dayref,anneeref,day_step,nday,offline, iphysiq
    29   USE inifis_mod, ONLY: inifis
    30   USE time_phylmdz_mod, ONLY: init_time
    31   USE temps_mod, ONLY: annee_ref, day_ini, day_ref, start_time, calend, year_len
    32   USE infotrac_phy, ONLY: init_infotrac_phy
    33   USE phystokenc_mod, ONLY: init_phystokenc
    34   USE phyaqua_mod, ONLY: iniaqua
    35   USE comconst_mod, ONLY: omeg, rad
    36   USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic
     27    USE control_mod, ONLY: dayref, anneeref, day_step, nday, offline, iphysiq
     28    USE inifis_mod, ONLY: inifis
     29    USE time_phylmdz_mod, ONLY: init_time
     30    USE temps_mod, ONLY: annee_ref, day_ini, day_ref, start_time, calend, year_len
     31    USE infotrac_phy, ONLY: init_infotrac_phy
     32    USE phystokenc_mod, ONLY: init_phystokenc
     33    USE phyaqua_mod, ONLY: iniaqua
     34    USE comconst_mod, ONLY: omeg, rad
     35    USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic
    3736#ifdef CPP_PARA
    3837  USE parallel_lmdz, ONLY: mpi_size, mpi_rank
    3938  USE bands, ONLY: distrib_phys
    4039#endif
    41   USE lmdz_phys_omp_data, ONLY: klon_omp
    42   USE lmdz_ioipsl_getin_p, ONLY: getin_p
    43   USE slab_heat_transp_mod, ONLY: ini_slab_transp_geom
    44   IMPLICIT NONE
     40    USE lmdz_phys_omp_data, ONLY: klon_omp
     41    USE lmdz_ioipsl_getin_p, ONLY: getin_p
     42    USE slab_heat_transp_mod, ONLY: ini_slab_transp_geom
     43    USE lmdz_iniprint, ONLY: lunout, prt_level
     44    IMPLICIT NONE
    4545
    46   ! =======================================================================
    47   ! Initialisation of the physical constants and some positional and
    48   ! geometrical arrays for the physics
    49   ! =======================================================================
     46    ! =======================================================================
     47    ! Initialisation of the physical constants and some positional and
     48    ! geometrical arrays for the physics
     49    ! =======================================================================
    5050
    51   include "dimensions.h"
    52   include "paramet.h"
    53   include "iniprint.h"
    54   include "tracstoke.h"
    55   include "comgeom.h"
     51    include "dimensions.h"
     52    include "paramet.h"
     53    include "tracstoke.h"
     54    include "comgeom.h"
    5655
    57   REAL, INTENT (IN) :: prad ! radius of the planet (m)
    58   REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2)
    59   REAL, INTENT (IN) :: pr ! reduced gas constant R/mu
    60   REAL, INTENT (IN) :: pcpp ! specific heat Cp
    61   REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
    62   INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
    63   INTEGER, INTENT (IN) :: ii ! number of atmospheric columns along longitudes
    64   INTEGER, INTENT (IN) :: jj ! number of atompsheric columns along latitudes
    65   INTEGER, INTENT(IN) :: nbp ! number of physics columns for this MPI process
    66   INTEGER, INTENT(IN) :: communicator ! MPI communicator
    67   REAL, INTENT (IN) :: rlatudyn(jj+1) ! latitudes of the physics grid
    68   REAL, INTENT (IN) :: rlatvdyn(jj) ! latitude boundaries of the physics grid
    69   REAL, INTENT (IN) :: rlonvdyn(ii+1) ! longitudes of the physics grid
    70   REAL, INTENT (IN) :: rlonudyn(ii+1) ! longitude boundaries of the physics grid
    71   REAL, INTENT (IN) :: airedyn(ii+1,jj+1) ! area of the dynamics grid (m2)
    72   REAL, INTENT (IN) :: cudyn((ii+1)*(jj+1)) ! cu coeff. (u_covariant = cu * u)
    73   REAL, INTENT (IN) :: cvdyn((ii+1)*jj) ! cv coeff. (v_covariant = cv * v)
    74   INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
    75   REAL, INTENT (IN) :: ptimestep !physics time step (s)
    76   INTEGER, INTENT (IN) :: iflag_phys ! type of physics to be called
     56    REAL, INTENT (IN) :: prad ! radius of the planet (m)
     57    REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2)
     58    REAL, INTENT (IN) :: pr ! reduced gas constant R/mu
     59    REAL, INTENT (IN) :: pcpp ! specific heat Cp
     60    REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
     61    INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
     62    INTEGER, INTENT (IN) :: ii ! number of atmospheric columns along longitudes
     63    INTEGER, INTENT (IN) :: jj ! number of atompsheric columns along latitudes
     64    INTEGER, INTENT(IN) :: nbp ! number of physics columns for this MPI process
     65    INTEGER, INTENT(IN) :: communicator ! MPI communicator
     66    REAL, INTENT (IN) :: rlatudyn(jj + 1) ! latitudes of the physics grid
     67    REAL, INTENT (IN) :: rlatvdyn(jj) ! latitude boundaries of the physics grid
     68    REAL, INTENT (IN) :: rlonvdyn(ii + 1) ! longitudes of the physics grid
     69    REAL, INTENT (IN) :: rlonudyn(ii + 1) ! longitude boundaries of the physics grid
     70    REAL, INTENT (IN) :: airedyn(ii + 1, jj + 1) ! area of the dynamics grid (m2)
     71    REAL, INTENT (IN) :: cudyn((ii + 1) * (jj + 1)) ! cu coeff. (u_covariant = cu * u)
     72    REAL, INTENT (IN) :: cvdyn((ii + 1) * jj) ! cv coeff. (v_covariant = cv * v)
     73    INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
     74    REAL, INTENT (IN) :: ptimestep !physics time step (s)
     75    INTEGER, INTENT (IN) :: iflag_phys ! type of physics to be called
    7776
    78   INTEGER :: ibegin, iend, offset
    79   INTEGER :: i,j,k
    80   CHARACTER (LEN=20) :: modname = 'iniphysiq'
    81   CHARACTER (LEN=80) :: abort_message
    82  
    83   LOGICAL :: slab_hdiff
    84   INTEGER :: slab_ekman
    85   CHARACTER (LEN = 6) :: type_ocean
     77    INTEGER :: ibegin, iend, offset
     78    INTEGER :: i, j, k
     79    CHARACTER (LEN = 20) :: modname = 'iniphysiq'
     80    CHARACTER (LEN = 80) :: abort_message
     81
     82    LOGICAL :: slab_hdiff
     83    INTEGER :: slab_ekman
     84    CHARACTER (LEN = 6) :: type_ocean
    8685
    8786#ifndef CPP_PARA
    88   INTEGER,PARAMETER :: mpi_rank=0
    89   INTEGER, PARAMETER :: mpi_size = 1
    90   INTEGER :: distrib_phys(mpi_rank:mpi_rank)=(jjm-1)*iim+2
     87    INTEGER, PARAMETER :: mpi_rank = 0
     88    INTEGER, PARAMETER :: mpi_size = 1
     89    INTEGER :: distrib_phys(mpi_rank:mpi_rank) = (jjm - 1) * iim + 2
    9190#endif
    9291
    93   ! --> initialize physics distribution, global fields and geometry
    94   ! (i.e. things in phy_common or dynphy_lonlat)
    95   CALL inigeomphy(ii,jj,nlayer, &
    96                nbp, communicator, &
    97                rlatudyn,rlatvdyn, &
    98                rlonudyn,rlonvdyn, &
    99                airedyn,cudyn,cvdyn)
     92    ! --> initialize physics distribution, global fields and geometry
     93    ! (i.e. things in phy_common or dynphy_lonlat)
     94    CALL inigeomphy(ii, jj, nlayer, &
     95            nbp, communicator, &
     96            rlatudyn, rlatvdyn, &
     97            rlonudyn, rlonvdyn, &
     98            airedyn, cudyn, cvdyn)
    10099
    101   ! --> now initialize things specific to the phylmd physics package
    102  
    103 !!$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/)
    104 !       Copy all threadprivate variables in temps_mod
    105 !$OMP PARALLEL DEFAULT(SHARED) COPYIN(annee_ref,day_ini,day_ref,start_time)
     100    ! --> now initialize things specific to the phylmd physics package
    106101
    107   ! Initialize physical constants in physics:
    108   CALL inifis(punjours,prad,pg,pr,pcpp)
     102    !!$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/)
     103    !   Copy all threadprivate variables in temps_mod
     104    !$OMP PARALLEL DEFAULT(SHARED) COPYIN(annee_ref,day_ini,day_ref,start_time)
    109105
    110   CALL init_time(annee_ref,day_ref,day_ini,start_time,nday,ptimestep)
     106    ! Initialize physical constants in physics:
     107    CALL inifis(punjours, prad, pg, pr, pcpp)
    111108
    112   ! Initialize dimphy module (unless in 1D where it has already been done)
    113 !  IF (klon_glo>1) CALL Init_dimphy(klon_omp,nlayer)
     109    CALL init_time(annee_ref, day_ref, day_ini, start_time, nday, ptimestep)
    114110
    115   ! Copy over "offline" settings
    116   CALL init_phystokenc(offline,istphy)
     111    ! Initialize dimphy module (unless in 1D where it has already been done)
     112    !  IF (klon_glo>1) CALL Init_dimphy(klon_omp,nlayer)
    117113
    118   ! Initialization for slab heat transport
    119   type_ocean="force"
    120   CALL getin_p('type_ocean',type_ocean)
    121   slab_hdiff=.FALSE.
    122   CALL getin_p('slab_hdiff',slab_hdiff)
    123   slab_ekman=0
    124   CALL getin_p('slab_ekman',slab_ekman)
    125   IF ((type_ocean=='slab').AND.(slab_hdiff.OR.(slab_ekman>0))) THEN
    126      CALL ini_slab_transp_geom(ip1jm,ip1jmp1,unsairez,fext,unsaire,&
    127                                   cu,cuvsurcv,cv,cvusurcu, &
    128                                   aire,apoln,apols, &
    129                                   aireu,airev,rlatvdyn,rad,omeg)
    130   END IF
     114    ! Copy over "offline" settings
     115    CALL init_phystokenc(offline, istphy)
    131116
    132   ! Initialize tracer names, numbers, etc. for physics
    133   CALL init_infotrac_phy
     117    ! Initialization for slab heat transport
     118    type_ocean = "force"
     119    CALL getin_p('type_ocean', type_ocean)
     120    slab_hdiff = .FALSE.
     121    CALL getin_p('slab_hdiff', slab_hdiff)
     122    slab_ekman = 0
     123    CALL getin_p('slab_ekman', slab_ekman)
     124    IF ((type_ocean=='slab').AND.(slab_hdiff.OR.(slab_ekman>0))) THEN
     125      CALL ini_slab_transp_geom(ip1jm, ip1jmp1, unsairez, fext, unsaire, &
     126              cu, cuvsurcv, cv, cvusurcu, &
     127              aire, apoln, apols, &
     128              aireu, airev, rlatvdyn, rad, omeg)
     129    END IF
    134130
    135   ! Initializations for Reprobus
    136   IF (type_trac == 'repr') THEN
     131    ! Initialize tracer names, numbers, etc. for physics
     132    CALL init_infotrac_phy
     133
     134    ! Initializations for Reprobus
     135    IF (type_trac == 'repr') THEN
    137136#ifdef REPROBUS
    138137    CALL Init_chem_rep_phys(klon_omp,nlayer)
    … …  
    141140          distrib_phys,communicator)
    142141#endif
    143   ENDIF
    144 !$OMP END PARALLEL
     142    ENDIF
     143    !$OMP END PARALLEL
    145144
    146 
    147   IF (type_trac == 'repr') THEN
     145    IF (type_trac == 'repr') THEN
    148146#ifdef REPROBUS
    149147    CALL init_reprobus_para( &
    … …  
    151149          distrib_phys,communicator)
    152150#endif
    153   ENDIF
     151    ENDIF
    154152
    155 !!$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/)
    156 !$OMP PARALLEL DEFAULT(SHARED)
    157   ! Additional initializations for aquaplanets
    158   IF (iflag_phys>=100) THEN
    159     CALL iniaqua(klon_omp,year_len,iflag_phys)
    160   END IF
     153    !!$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/)
     154    !$OMP PARALLEL DEFAULT(SHARED)
     155    ! Additional initializations for aquaplanets
     156    IF (iflag_phys>=100) THEN
     157      CALL iniaqua(klon_omp, year_len, iflag_phys)
     158    END IF
    161159
    162   IF (ANY(type_trac == ['inca','inco'])) THEN
    163      CALL init_inca_dim_reg(nbp_lon, nbp_lat - 1, &
    164           rlonudyn, rlatudyn, rlonvdyn, rlatvdyn)
    165   END IF
     160    IF (ANY(type_trac == ['inca', 'inco'])) THEN
     161      CALL init_inca_dim_reg(nbp_lon, nbp_lat - 1, &
     162              rlonudyn, rlatudyn, rlonvdyn, rlatvdyn)
     163    END IF
    166164
    167 !$OMP END PARALLEL
     165    !$OMP END PARALLEL
    168166
    169 END SUBROUTINE iniphysiq
     167  END SUBROUTINE iniphysiq
    170168
    171169END MODULE iniphysiq_mod
Note: See TracChangeset for help on using the changeset viewer.