Ignore:
Timestamp:
Jul 29, 2024, 11:01:04 PM (3 months ago)
Author:
abarral
Message:

Put YOMCST.h into modules

Location:
LMDZ6/branches/Amaury_dev/libf/phylmdiso
Files:
17 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90

    r5137 r5144  
    161161#endif 
    162162#endif
     163
     164USE lmdz_yomcst
     165
    163166IMPLICIT NONE
    164   include "YOMCST.h"
    165167
    166168! Arguments :
    … …  
    685687              , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col
    686688USE lmdz_clesphys
     689USE lmdz_yomcst
    687690
    688691IMPLICIT NONE
    689   include "YOMCST.h"
    690692
    691693! Arguments :
    … …  
    835837                    zh_qw_col, zh_ql_col, zh_qs_col, zh_qbs_col, zh_col)
    836838
     839  USE lmdz_yomcst
    837840IMPLICIT NONE
    838   include "YOMCST.h"
    839841
    840842INTEGER,                    INTENT(IN)    :: nlon,nlev
    … …  
    916918      , rain_lsc, snow_lsc
    917919USE climb_hq_mod, ONLY: d_h_col_vdf, f_h_bnd
     920USE lmdz_yomcst
     921
    918922IMPLICIT NONE
    919 include "YOMCST.h"
    920923
    921924! Arguments :

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/ajsec.F90

    r5117 r5144  
    1919#endif
    2020#endif
     21USE lmdz_yomcst
    2122  IMPLICIT NONE
    2223  ! ======================================================================
    … …  
    2930  ! d_t-----output-R-Incrementation de la temperature
    3031  ! ======================================================================
    31   include "YOMCST.h"
    3232  REAL paprs(klon, klev+1), pplay(klon, klev)
    3333  REAL t(klon, klev), q(klon, klev)
    … …  
    313313#endif
    314314#endif
     315        USE lmdz_yomcst
     316
    315317  IMPLICIT NONE
    316318  ! ======================================================================
    … …  
    323325  ! d_t-----output-R-Incrementation de la temperature
    324326  ! ======================================================================
    325   include "YOMCST.h"
    326327  REAL paprs(klon, klev+1), pplay(klon, klev)
    327328  REAL t(klon, klev), q(klon, klev)
    … …  
    579580SUBROUTINE ajsec_old(paprs, pplay, t, d_t)
    580581  USE dimphy
     582        USE lmdz_yomcst
     583
    581584  IMPLICIT NONE
    582585  ! ======================================================================
    … …  
    589592  ! d_t-----output-R-Incrementation de la temperature
    590593  ! ======================================================================
    591   include "YOMCST.h"
    592594  REAL paprs(klon, klev+1), pplay(klon, klev)
    593595  REAL t(klon, klev)

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/calwake.F90

    r5117 r5144  
    4242#endif
    4343#endif
     44USE lmdz_yomcst
     45
    4446  IMPLICIT NONE
    4547  ! ======================================================================
    46   include "YOMCST.h"
    4748
    4849  ! Arguments

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/change_srf_frac_mod.F90

    r5137 r5144  
    3838#endif
    3939  USE lmdz_clesphys ! albedo SB
     40  USE lmdz_yomcst
    4041   
    41     INCLUDE "YOMCST.h"
    42 
     42
     43  IMPLICIT NONE
    4344
    4445

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/clift.F90

    r5116 r5144  
    1 
    21! $Header$
    32
    43SUBROUTINE clift(p, t, rr, rs, plcl, dplcldt, dplcldq)
    5 IMPLICIT NONE
     4  USE lmdz_yomcst
     5
     6  IMPLICIT NONE
    67  ! ***************************************************************
    78  ! *                                                             *
    … …  
    4142  ! on utilise les constantes thermo du Centre Europeen: (sb)
    4243
    43   include "YOMCST.h"
    44   REAL :: p,t,rr,rs,plcl,dplcldt,dplcldq,cpd,cpv,cl,cpvmcl,eps,alv0,a,b
    45   REAL :: rh,chi,alv
     44  REAL :: p, t, rr, rs, plcl, dplcldt, dplcldq, cpd, cpv, cl, cpvmcl, eps, alv0, a, b
     45  REAL :: rh, chi, alv
    4646
    4747  cpd = rcpd
    … …  
    4949  cl = rcw
    5050  cpvmcl = cl - cpv
    51   eps = rd/rv
     51  eps = rd / rv
    5252  alv0 = rlvtt
    5353
    … …  
    5757  b = 122.0
    5858
    59   rh = rr/rs
    60   chi = t/(a-b*rh-t)
    61   plcl = p*(rh**chi)
     59  rh = rr / rs
     60  chi = t / (a - b * rh - t)
     61  plcl = p * (rh**chi)
    6262
    63   alv = alv0 - cpvmcl*(t-273.15)
     63  alv = alv0 - cpvmcl * (t - 273.15)
    6464
    6565  ! -- sb: correction:
    6666  ! DPLCLDQ = PLCL*CHI*( 1./RR - B*CHI/T/RS*ALOG(RH) )
    67   dplcldq = plcl*chi*(1./rr+b*chi/t/rs*alog(rh))
     67  dplcldq = plcl * chi * (1. / rr + b * chi / t / rs * alog(rh))
    6868  ! sb --
    6969
    70   dplcldt = plcl*chi*((a-b*rh*(1.+alv/rv/t))/t**2*chi*alog(rh)-alv/rv/t**2)
    71 
    72 
     70  dplcldt = plcl * chi * ((a - b * rh * (1. + alv / rv / t)) / t**2 * chi * alog(rh) - alv / rv / t**2)
    7371
    7472END SUBROUTINE clift

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/climb_hq_mod.F90

    r5139 r5144  
    5757            )
    5858  USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
     59  USE lmdz_yomcst
    5960#ifdef ISOVERIF
    6061USE isotopes_mod, ONLY: iso_eau,iso_HDO
    … …  
    126127! Include
    127128!****************************************************************************************
    128     INCLUDE "YOMCST.h"
    129129
    130130#ifdef ISO
    … …  
    421421! where X is H or Q, and k the vertical level k=1,klev
    422422
    423     INCLUDE "YOMCST.h"
     423    USE lmdz_yomcst
     424
     425    IMPLICIT NONE
     426
    424427! Input arguments
    425428!****************************************************************************************
    … …  
    499502
    500503  USE lmdz_compbl, ONLY: iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
     504  USE lmdz_yomcst
    501505#ifdef ISOVERIF
    502506USE infotrac_phy, ONLY: nzone
    … …  
    552556!#endif
    553557#endif
    554  
    555 ! Include
    556 !****************************************************************************************
    557     INCLUDE "YOMCST.h"
    558 !****************************************************************************************
     558
    559559! 1)
    560560! Definition of some variables

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90

    r5143 r5144  
    4343  USE dimphy
    4444  USE infotrac_phy, ONLY: nbtr
    45   USE lmdz_YOETHF
     45  USE lmdz_yoethf
    4646#ifdef ISO
    4747  USE infotrac_phy, ONLY: ntraciso=>ntiso
    … …  
    6767  USE lmdz_conema3
    6868  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
     69  USE lmdz_yomcst
    6970
    7071  IMPLICIT NONE
    … …  
    296297!$OMP THREADPRIVATE(itap, igout)
    297298
    298 
    299   include "YOMCST.h"
    300   include "YOMCST2.h"
     299 include "YOMCST2.h"
    301300
    302301  IF (first) THEN

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_enthalpmix.F90

    r5143 r5144  
    1818  ! **************************************************************
    1919USE lmdz_cvthermo
    20 USE lmdz_YOETHF
     20USE lmdz_yoethf
    2121USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
     22USE lmdz_yomcst
    2223
    2324  IMPLICIT NONE
    … …  
    3233  ! ===============================================================
    3334
    34   include "YOMCST.h"
    3535!inputs:
    3636  INTEGER, INTENT (IN)                      :: nd, len

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_estatmix.F90

    r5143 r5144  
    1919  ! ****************************************************************
    2020USE lmdz_cvthermo
    21 USE lmdz_YOETHF
     21USE lmdz_yoethf
    2222USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
     23USE lmdz_yomcst
    2324
    2425  IMPLICIT NONE
    … …  
    3334  ! ===============================================================
    3435
    35   include "YOMCST.h"
    3636!inputs:
    3737  INTEGER, INTENT (IN)                      :: nd, len

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_driver.F90

    r5142 r5144  
    12671267SUBROUTINE cv_thermo(iflag_con)
    12681268  USE lmdz_cvthermo
     1269  USE lmdz_yomcst
    12691270
    12701271  IMPLICIT NONE
    … …  
    12731274  ! Set thermodynamical constants for convectL
    12741275  ! -------------------------------------------------------------
    1275 
    1276   include "YOMCST.h"
    12771276
    12781277  INTEGER iflag_con

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90

    r5143 r5144  
    1284312843    USE isotrac_mod, ONLY: izone_cont,index_zone,index_iso
    1284412844#endif
    12845 USE lmdz_YOETHF
     12845USE lmdz_yoethf
    1284612846USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
    1284712847
    … …  
    1340713407&       bassin_map
    1340813408#endif
    13409 USE lmdz_YOETHF
     13409USE lmdz_yoethf
    1341013410USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
    1341113411
    … …  
    1431814318&       bassin_map
    1431914319#endif
    14320 USE lmdz_YOETHF
     14320USE lmdz_yoethf
    1432114321USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
    1432214322

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90

    r5143 r5144  
    6868#endif
    6969
    70 USE lmdz_YOETHF
     70USE lmdz_yoethf
    7171  USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
     72  USE lmdz_yomcst
    7273
    7374  IMPLICIT NONE
    … …  
    9798  !   fl_cor_ebil= 0 pour reproduire anciens bugs
    9899  !======================================================================
    99   include "YOMCST.h"
    100100
    101101  ! Principaux inputs:

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90

    r5141 r5144  
    4242#endif
    4343USE lmdz_cvthermo
     44USE lmdz_yomcst
    4445
    4546  IMPLICIT NONE
    … …  
    136137  ! Déclaration de variables
    137138  ! -------------------------------------------------------------------------
    138 
    139   include "YOMCST.h"
    140139
    141140  ! Arguments en entree

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyaqua_mod.F90

    r5137 r5144  
    1 
    21! $Id: phyaqua_mod.F90 3579 2019-10-09 13:11:07Z fairhead $
    32
    … …  
    98CONTAINS
    109
    11   SUBROUTINE iniaqua(nlon,year_len,iflag_phys)
     10  SUBROUTINE iniaqua(nlon, year_len, iflag_phys)
    1211
    1312    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    3433    USE phys_state_var_mod
    3534    USE time_phylmdz_mod, ONLY: day_ref, ndays, pdtphys, &
    36                                 day_ini,day_end
     35            day_ini, day_end
    3736    USE indice_sol_mod
    3837    USE lmdz_physical_constants, ONLY: pi
    39 !    USE ioipsl
     38    !    USE ioipsl
    4039    USE lmdz_phys_para, ONLY: is_master
    4140    USE lmdz_phys_transfert_para, ONLY: bcast
    4241    USE lmdz_grid_phy
    4342    USE lmdz_ioipsl_getin_p, ONLY: getin_p
    44     USE phys_cal_mod , ONLY: calend, year_len_phy => year_len
     43    USE phys_cal_mod, ONLY: calend, year_len_phy => year_len
    4544    USE lmdz_clesphys
    4645#ifdef ISO
    4746  USE infotrac_phy, ONLY: niso
    4847#endif
     48    USE lmdz_yomcst
    4949
    5050    IMPLICIT NONE
    5151
    52     include "YOMCST.h"
    5352    include "dimsoil.h"
    5453
    5554    INTEGER, INTENT (IN) :: nlon, year_len, iflag_phys
    5655    ! IM ajout latfi, lonfi
    57 !    REAL, INTENT (IN) :: lonfi(nlon), latfi(nlon)
     56    !    REAL, INTENT (IN) :: lonfi(nlon), latfi(nlon)
    5857
    5958    INTEGER type_profil, type_aqua
    … …  
    103102
    104103    INTEGER, SAVE :: read_climoz = 0 ! read ozone climatology
    105 !$OMP THREADPRIVATE(read_climoz)
     104    !$OMP THREADPRIVATE(read_climoz)
    106105
    107106    ! -------------------------------------------------------------------------
    … …  
    119118
    120119    INTEGER longcles
    121     PARAMETER (longcles=20)
     120    PARAMETER (longcles = 20)
    122121    REAL clesphy0(longcles)
    123122
    … …  
    132131
    133132    ! Local
    134     CHARACTER (LEN=20) :: modname='phyaqua'
    135     CHARACTER (LEN=80) :: abort_message
     133    CHARACTER (LEN = 20) :: modname = 'phyaqua'
     134    CHARACTER (LEN = 80) :: abort_message
    136135
    137136
    … …  
    145144
    146145    !IF (calend .EQ. "earth_360d") Then
    147       year_len_phy = year_len
     146    year_len_phy = year_len
    148147    !END IF
    149    
     148
    150149    IF (year_len/=360) THEN
    151       write (*,*) year_len
    152       write (*,*) 'iniaqua: 360 day calendar is required !'
     150      write (*, *) year_len
     151      write (*, *) 'iniaqua: 360 day calendar is required !'
    153152      stop
    154153    endif
    155154
    156     type_aqua = iflag_phys/100
    157     type_profil = iflag_phys - type_aqua*100
     155    type_aqua = iflag_phys / 100
     156    type_profil = iflag_phys - type_aqua * 100
    158157    PRINT *, 'iniaqua:type_aqua, type_profil', type_aqua, type_profil
    159158
    160159    IF (klon/=nlon) THEN
    161160      WRITE (*, *) 'iniaqua: klon=', klon, ' nlon=', nlon
    162       abort_message= 'probleme de dimensions dans iniaqua'
    163       CALL abort_physic(modname,abort_message,1)
     161      abort_message = 'probleme de dimensions dans iniaqua'
     162      CALL abort_physic(modname, abort_message, 1)
    164163    END IF
    165164    CALL phys_state_var_init(read_climoz)
    166 
    167165
    168166    read_climoz = 0
    … …  
    192190    solaire = 1365.
    193191    CALL getin_p('solaire', solaire)
    194  
     192
    195193    ! CALL getin('albedo',albedo) ! albedo is set below, depending on
    196194    ! type_aqua
    … …  
    269267    IF (grid_type==unstructured) THEN
    270268      CALL writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
    271                              phy_fter, phy_foce, phy_flic, phy_fsic)
     269              phy_fter, phy_foce, phy_flic, phy_fsic)
    272270    ELSE
    273      
    274        CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
    275                      phy_fter, phy_foce, phy_flic, phy_fsic)
     271
     272      CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
     273              phy_fter, phy_foce, phy_flic, phy_fsic)
    276274    ENDIF
    277275
    … …  
    284282
    285283    timestep = pdtphys
    286     radpas = nint(rday/timestep/float(nbapp_rad))
     284    radpas = nint(rday / timestep / float(nbapp_rad))
    287285
    288286    DO i = 1, longcles
    … …  
    348346    snsrf(:, :) = 0. ! couverture de neige des sous surface
    349347    z0m(:, :) = rugos ! couverture de neige des sous surface
    350     z0h=z0m
    351 
     348    z0h = z0m
    352349
    353350    CALL pbl_surface_init(fder, snsrf, qsolsrf, tsoil)
    … …  
    358355    PRINT *, 'iniaqua: before phyredem'
    359356
    360     pbl_tke(:,:,:) = 1.e-8
     357    pbl_tke(:, :, :) = 1.e-8
    361358    falb1 = albedo
    362359    falb2 = albedo
    … …  
    376373    detr_therm = 0.
    377374    ale_bl = 0.
    378     ale_bl_trig =0.
    379     alp_bl =0.
    380     treedrg(:,:,:)=0.
     375    ale_bl_trig = 0.
     376    alp_bl = 0.
     377    treedrg(:, :, :) = 0.
    381378
    382379    u10m = 0.
    383380    v10m = 0.
    384381
    385     ql_ancien   = 0.
    386     qs_ancien   = 0.
    387     u_ancien    = 0.
    388     v_ancien    = 0.
    389     prw_ancien  = 0.
     382    ql_ancien = 0.
     383    qs_ancien = 0.
     384    u_ancien = 0.
     385    v_ancien = 0.
     386    prw_ancien = 0.
    390387    prlw_ancien = 0.
    391     prsw_ancien = 0. 
    392 
    393     ale_wake    = 0.
    394     ale_bl_stat = 0. 
    395 
    396 
    397 !ym error : the sub surface dimension is the third not second : forgotten for iniaqua
    398 !    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
    399 !    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
    400     falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
    401     falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
    402 
    403 !ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
    404 !ym probably the uninitialized value was 0 for standard (regular grid) case
    405     falb_dif(:,:,:)=0
    406 
     388    prsw_ancien = 0.
     389
     390    ale_wake = 0.
     391    ale_bl_stat = 0.
     392
     393
     394    !ym error : the sub surface dimension is the third not second : forgotten for iniaqua
     395    !    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
     396    !    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
     397    falb_dir(:, :, is_ter) = 0.08; falb_dir(:, :, is_lic) = 0.6
     398    falb_dir(:, :, is_oce) = 0.5;  falb_dir(:, :, is_sic) = 0.6
     399
     400    !ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
     401    !ym probably the uninitialized value was 0 for standard (regular grid) case
     402    falb_dif(:, :, :) = 0
    407403
    408404    CALL phyredem('startphy.nc')
    … …  
    410406    PRINT *, 'iniaqua: after phyredem'
    411407    CALL phys_state_var_end
    412 
    413408
    414409  END SUBROUTINE iniaqua
    … …  
    419414  SUBROUTINE zenang_an(cycle_diurne, gmtime, rlat, rlon, rmu0, fract)
    420415    USE dimphy
     416    USE lmdz_yomcst
     417
    421418    IMPLICIT NONE
    422419    ! ====================================================================
    … …  
    450447    ! pmu0-----OUTPUT: angle zenithal moyen entre gmtime et gmtime+pdtrad
    451448    ! frac-----OUTPUT: ensoleillement moyen entre gmtime et gmtime+pdtrad
    452     ! ================================================================
    453     include "YOMCST.h"
    454     ! ================================================================
     449
    455450    LOGICAL cycle_diurne
    456451    REAL gmtime
    … …  
    461456    REAL pi_local
    462457
    463 
    464458    REAL rmu0m(klon), rmu0a(klon)
    465459
    466 
    467     pi_local = 4.0*atan(1.0)
     460    pi_local = 4.0 * atan(1.0)
    468461
    469462    ! ================================================================
    … …  
    475468      ! Calcule du flux moyen
    476469      IF (abs(rlat(i))<=28.75) THEN
    477         rmu0m(i) = (210.1924+206.6059*cos(0.0174533*rlat(i))**2)/1365.
     470        rmu0m(i) = (210.1924 + 206.6059 * cos(0.0174533 * rlat(i))**2) / 1365.
    478471      ELSE IF (abs(rlat(i))<=43.75) THEN
    479         rmu0m(i) = (187.4562+236.1853*cos(0.0174533*rlat(i))**2)/1365.
     472        rmu0m(i) = (187.4562 + 236.1853 * cos(0.0174533 * rlat(i))**2) / 1365.
    480473      ELSE IF (abs(rlat(i))<=71.25) THEN
    481         rmu0m(i) = (162.4439+284.1192*cos(0.0174533*rlat(i))**2)/1365.
     474        rmu0m(i) = (162.4439 + 284.1192 * cos(0.0174533 * rlat(i))**2) / 1365.
    482475      ELSE
    483         rmu0m(i) = (172.8125+183.7673*cos(0.0174533*rlat(i))**2)/1365.
     476        rmu0m(i) = (172.8125 + 183.7673 * cos(0.0174533 * rlat(i))**2) / 1365.
    484477      END IF
    485478    END DO
    … …  
    495488
    496489      DO i = 1, klon
    497         rmu0a(i) = 2.*rmu0m(i)*sqrt(2.)*pi_local/(4.-pi_local)
    498         rmu0(i) = rmu0a(i)*abs(sin(pi_local*gmtime+pi_local*rlon(i)/360.)) - &
    499           rmu0a(i)/sqrt(2.)
     490        rmu0a(i) = 2. * rmu0m(i) * sqrt(2.) * pi_local / (4. - pi_local)
     491        rmu0(i) = rmu0a(i) * abs(sin(pi_local * gmtime + pi_local * rlon(i) / 360.)) - &
     492                rmu0a(i) / sqrt(2.)
    500493      END DO
    501494
    … …  
    522515      DO i = 1, klon
    523516        fract(i) = 0.5
    524         rmu0(i) = rmu0m(i)*2.
     517        rmu0(i) = rmu0m(i) * 2.
    525518      END DO
    526519
    527520    END IF
    528521
    529 
    530522  END SUBROUTINE zenang_an
    531523
    … …  
    533525
    534526  SUBROUTINE writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
    535       phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
     527          phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
    536528
    537529    USE lmdz_phys_para, ONLY: is_omp_master, klon_mpi
    … …  
    553545
    554546    REAL :: phy_mpi(klon_mpi, 360) ! temporary variable, to store phy_***(:)
    555       ! on the whole physics grid
    556  
     547    ! on the whole physics grid
     548
    557549    PRINT *, 'writelim: Ecriture du fichier limit'
    558550
    559551    CALL gather_omp(phy_foce, phy_mpi)
    560     IF (is_omp_master) CALL xios_send_field('foce_limout',phy_mpi)
     552    IF (is_omp_master) CALL xios_send_field('foce_limout', phy_mpi)
    561553
    562554    CALL gather_omp(phy_fsic, phy_mpi)
    563     IF (is_omp_master) CALL xios_send_field('fsic_limout',phy_mpi)
    564      
     555    IF (is_omp_master) CALL xios_send_field('fsic_limout', phy_mpi)
     556
    565557    CALL gather_omp(phy_fter, phy_mpi)
    566     IF (is_omp_master) CALL xios_send_field('fter_limout',phy_mpi)
    567      
     558    IF (is_omp_master) CALL xios_send_field('fter_limout', phy_mpi)
     559
    568560    CALL gather_omp(phy_flic, phy_mpi)
    569     IF (is_omp_master) CALL xios_send_field('flic_limout',phy_mpi)
     561    IF (is_omp_master) CALL xios_send_field('flic_limout', phy_mpi)
    570562
    571563    CALL gather_omp(phy_sst, phy_mpi)
    572     IF (is_omp_master) CALL xios_send_field('sst_limout',phy_mpi)
     564    IF (is_omp_master) CALL xios_send_field('sst_limout', phy_mpi)
    573565
    574566    CALL gather_omp(phy_bil, phy_mpi)
    575     IF (is_omp_master) CALL xios_send_field('bils_limout',phy_mpi)
     567    IF (is_omp_master) CALL xios_send_field('bils_limout', phy_mpi)
    576568
    577569    CALL gather_omp(phy_alb, phy_mpi)
    578     IF (is_omp_master) CALL xios_send_field('alb_limout',phy_mpi)
     570    IF (is_omp_master) CALL xios_send_field('alb_limout', phy_mpi)
    579571
    580572    CALL gather_omp(phy_rug, phy_mpi)
    581     IF (is_omp_master) CALL xios_send_field('rug_limout',phy_mpi)
     573    IF (is_omp_master) CALL xios_send_field('rug_limout', phy_mpi)
    582574
    583575  END SUBROUTINE writelim_unstruct
    584576
    585577
    586 
    587578  SUBROUTINE writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
    588       phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
     579          phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
    589580
    590581    USE lmdz_phys_para, ONLY: is_master
    … …  
    592583    USE lmdz_phys_transfert_para, ONLY: gather
    593584    USE phys_cal_mod, ONLY: year_len
    594     USE netcdf, ONLY:nf90_clobber,nf90_close,nf90_noerr,nf90_strerror,nf90_put_att,nf90_def_var,&
    595             nf90_def_dim,nf90_create,nf90_put_var,nf90_unlimited,nf90_global,nf90_64bit_offset,&
     585    USE netcdf, ONLY: nf90_clobber, nf90_close, nf90_noerr, nf90_strerror, nf90_put_att, nf90_def_var, &
     586            nf90_def_dim, nf90_create, nf90_put_var, nf90_unlimited, nf90_global, nf90_64bit_offset, &
    596587            nf90_enddef
    597588    USE lmdz_cppkeys_wrapper, ONLY: nf90_format
    … …  
    611602
    612603    REAL :: phy_glo(klon_glo, year_len) ! temporary variable, to store phy_***(:)
    613       ! on the whole physics grid
     604    ! on the whole physics grid
    614605    INTEGER :: k
    615606    INTEGER ierr
    … …  
    627618      PRINT *, 'writelim: Ecriture du fichier limit'
    628619
    629       ierr = nf90_create('limit.nc', IOR(nf90_clobber,nf90_64bit_offset), nid)
     620      ierr = nf90_create('limit.nc', IOR(nf90_clobber, nf90_64bit_offset), nid)
    630621
    631622      ierr = nf90_put_att(nid, nf90_global, 'title', &
    632         'Fichier conditions aux limites')
     623              'Fichier conditions aux limites')
    633624      !        ierr = nf90_def_dim (nid, "points_physiques", klon, ndim)
    634625      ierr = nf90_def_dim(nid, 'points_physiques', klon_glo, ndim)
    … …  
    643634      ierr = nf90_def_var(nid, 'NAT', nf90_format, dims, id_nat)
    644635      ierr = nf90_put_att(nid, id_nat, 'title', &
    645         'Nature du sol (0,1,2,3)')
     636              'Nature du sol (0,1,2,3)')
    646637
    647638      ierr = nf90_def_var(nid, 'SST', nf90_format, dims, id_sst)
    648639      ierr = nf90_put_att(nid, id_sst, 'title', &
    649         'Temperature superficielle de la mer')
     640              'Temperature superficielle de la mer')
    650641
    651642      ierr = nf90_def_var(nid, 'BILS', nf90_format, dims, id_bils)
    652643      ierr = nf90_put_att(nid, id_bils, 'title', &
    653         'Reference flux de chaleur au sol')
     644              'Reference flux de chaleur au sol')
    654645
    655646      ierr = nf90_def_var(nid, 'ALB', nf90_format, dims, id_alb)
    … …  
    660651
    661652      ierr = nf90_def_var(nid, 'FTER', nf90_format, dims, id_fter)
    662       ierr = nf90_put_att(nid, id_fter, 'title','Frac. Land')
     653      ierr = nf90_put_att(nid, id_fter, 'title', 'Frac. Land')
    663654      ierr = nf90_def_var(nid, 'FOCE', nf90_format, dims, id_foce)
    664       ierr = nf90_put_att(nid, id_foce, 'title','Frac. Ocean')
     655      ierr = nf90_put_att(nid, id_foce, 'title', 'Frac. Ocean')
    665656      ierr = nf90_def_var(nid, 'FSIC', nf90_format, dims, id_fsic)
    666       ierr = nf90_put_att(nid, id_fsic, 'title','Frac. Sea Ice')
     657      ierr = nf90_put_att(nid, id_fsic, 'title', 'Frac. Sea Ice')
    667658      ierr = nf90_def_var(nid, 'FLIC', nf90_format, dims, id_flic)
    668       ierr = nf90_put_att(nid, id_flic, 'title','Frac. Land Ice')
     659      ierr = nf90_put_att(nid, id_flic, 'title', 'Frac. Land Ice')
    669660
    670661      ierr = nf90_enddef(nid)
    … …  
    780771  SUBROUTINE profil_sst(nlon, rlatd, type_profil, phy_sst)
    781772    USE dimphy
    782     USE phys_cal_mod , ONLY: year_len
     773    USE phys_cal_mod, ONLY: year_len
    783774    IMPLICIT NONE
    784775
    … …  
    787778    INTEGER imn, imx, amn, amx, kmn, kmx
    788779    INTEGER p, pplus, nlat_max
    789     PARAMETER (nlat_max=72)
     780    PARAMETER (nlat_max = 72)
    790781    REAL x_anom_sst(nlat_max)
    791     CHARACTER (LEN=20) :: modname='profil_sst'
    792     CHARACTER (LEN=80) :: abort_message
     782    CHARACTER (LEN = 20) :: modname = 'profil_sst'
     783    CHARACTER (LEN = 80) :: abort_message
    793784
    794785    IF (klon/=nlon) THEN
    795        abort_message='probleme de dimensions dans profil_sst'
    796        CALL abort_physic(modname,abort_message,1)
     786      abort_message = 'probleme de dimensions dans profil_sst'
     787      CALL abort_physic(modname, abort_message, 1)
    797788    ENDIF
    798789    WRITE (*, *) ' profil_sst: type_profil=', type_profil
    … …  
    805796        ! Méthode 1 "Control" faible plateau à l'Equateur
    806797        DO j = 1, klon
    807           phy_sst(j, i) = 273. + 27.*(1-sin(1.5*rlatd(j))**2)
     798          phy_sst(j, i) = 273. + 27. * (1 - sin(1.5 * rlatd(j))**2)
    808799          ! PI/3=1.047197551
    809800          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    … …  
    815806        ! Méthode 2 "Flat" fort plateau à l'Equateur
    816807        DO j = 1, klon
    817           phy_sst(j, i) = 273. + 27.*(1-sin(1.5*rlatd(j))**4)
     808          phy_sst(j, i) = 273. + 27. * (1 - sin(1.5 * rlatd(j))**4)
    818809          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    819810            phy_sst(j, i) = 273.
    … …  
    821812        END DO
    822813      END IF
    823 
    824814
    825815      IF (type_profil==3) THEN
    826816        ! Méthode 3 "Qobs" plateau réel à l'Equateur
    827817        DO j = 1, klon
    828           phy_sst(j, i) = 273. + 0.5*27.*(2-sin(1.5*rlatd(j))**2-sin(1.5* &
    829             rlatd(j))**4)
     818          phy_sst(j, i) = 273. + 0.5 * 27. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 * &
     819                  rlatd(j))**4)
    830820          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    831821            phy_sst(j, i) = 273.
    … …  
    837827        ! Méthode 4 : Méthode 3 + SST+2 "Qobs" plateau réel à l'Equateur
    838828        DO j = 1, klon
    839           phy_sst(j, i) = 273. + 0.5*29.*(2-sin(1.5*rlatd(j))**2-sin(1.5* &
    840             rlatd(j))**4)
     829          phy_sst(j, i) = 273. + 0.5 * 29. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 * &
     830                  rlatd(j))**4)
    841831          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    842832            phy_sst(j, i) = 273.
    … …  
    848838        ! Méthode 5 : Méthode 3 + +2K "Qobs" plateau réel à l'Equateur
    849839        DO j = 1, klon
    850           phy_sst(j, i) = 273. + 2. + 0.5*27.*(2-sin(1.5*rlatd(j))**2-sin(1.5 &
    851             *rlatd(j))**4)
     840          phy_sst(j, i) = 273. + 2. + 0.5 * 27. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 &
     841                  * rlatd(j))**4)
    852842          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    853843            phy_sst(j, i) = 273. + 2.
    … …  
    863853        END DO
    864854      END IF
    865 
    866855
    867856      IF (type_profil==7) THEN
    … …  
    876865        ! Méthode 8 profil anomalies SST du modèle couplé AR4
    877866        DO j = 1, klon
    878           IF (rlatd(j)==rlatd(j-1)) THEN
     867          IF (rlatd(j)==rlatd(j - 1)) THEN
    879868            phy_sst(j, i) = 273. + x_anom_sst(pplus) + &
    880               0.5*27.*(2-sin(1.5*rlatd(j))**2-sin(1.5*rlatd(j))**4)
     869                    0.5 * 27. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 * rlatd(j))**4)
    881870            IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    882871              phy_sst(j, i) = 273. + x_anom_sst(pplus)
    … …  
    886875            pplus = 73 - p
    887876            phy_sst(j, i) = 273. + x_anom_sst(pplus) + &
    888               0.5*27.*(2-sin(1.5*rlatd(j))**2-sin(1.5*rlatd(j))**4)
     877                    0.5 * 27. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 * rlatd(j))**4)
    889878            IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    890879              phy_sst(j, i) = 273. + x_anom_sst(pplus)
    … …  
    898887        ! Méthode 5 : Méthode 3 + -2K "Qobs" plateau réel à l'Equateur
    899888        DO j = 1, klon
    900           phy_sst(j, i) = 273. - 2. + 0.5*27.*(2-sin(1.5*rlatd(j))**2-sin(1.5 &
    901             *rlatd(j))**4)
     889          phy_sst(j, i) = 273. - 2. + 0.5 * 27. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 &
     890                  * rlatd(j))**4)
    902891          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    903892            phy_sst(j, i) = 273. - 2.
    … …  
    905894        END DO
    906895      END IF
    907 
    908896
    909897      IF (type_profil==10) THEN
    910898        ! Méthode 10 : Méthode 3 + +4K "Qobs" plateau réel à l'Equateur
    911899        DO j = 1, klon
    912           phy_sst(j, i) = 273. + 4. + 0.5*27.*(2-sin(1.5*rlatd(j))**2-sin(1.5 &
    913             *rlatd(j))**4)
     900          phy_sst(j, i) = 273. + 4. + 0.5 * 27. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 &
     901                  * rlatd(j))**4)
    914902          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    915903            phy_sst(j, i) = 273. + 4.
    … …  
    921909        ! Méthode 11 : Méthode 3 + 4CO2 "Qobs" plateau réel à l'Equateur
    922910        DO j = 1, klon
    923           phy_sst(j, i) = 273. + 0.5*27.*(2-sin(1.5*rlatd(j))**2-sin(1.5* &
    924             rlatd(j))**4)
     911          phy_sst(j, i) = 273. + 0.5 * 27. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 * &
     912                  rlatd(j))**4)
    925913          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    926914            phy_sst(j, i) = 273.
    … …  
    932920        ! Méthode 12 : Méthode 10 + 4CO2 "Qobs" plateau réel à l'Equateur
    933921        DO j = 1, klon
    934           phy_sst(j, i) = 273. + 4. + 0.5*27.*(2-sin(1.5*rlatd(j))**2-sin(1.5 &
    935             *rlatd(j))**4)
     922          phy_sst(j, i) = 273. + 4. + 0.5 * 27. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 &
     923                  * rlatd(j))**4)
    936924          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    937925            phy_sst(j, i) = 273. + 4.
    … …  
    943931        ! Méthode 13 "Qmax" plateau réel à l'Equateur augmenté !
    944932        DO j = 1, klon
    945           phy_sst(j, i) = 273. + 0.5*29.*(2-sin(1.5*rlatd(j))**2-sin(1.5* &
    946             rlatd(j))**4)
     933          phy_sst(j, i) = 273. + 0.5 * 29. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 * &
     934                  rlatd(j))**4)
    947935          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    948936            phy_sst(j, i) = 273.
    … …  
    954942        ! Méthode 13 "Qmax2K" plateau réel à l'Equateur augmenté +2K !
    955943        DO j = 1, klon
    956           phy_sst(j, i) = 273. + 2. + 0.5*29.*(2-sin(1.5*rlatd(j))**2-sin(1.5 &
    957             *rlatd(j))**4)
     944          phy_sst(j, i) = 273. + 2. + 0.5 * 29. * (2 - sin(1.5 * rlatd(j))**2 - sin(1.5 &
     945                  * rlatd(j))**4)
    958946          IF ((rlatd(j)>1.0471975) .OR. (rlatd(j)<-1.0471975)) THEN
    959947            phy_sst(j, i) = 273.
    … …  
    963951
    964952      IF (type_profil==20) THEN
    965       PRINT*,'Profile SST 20'
    966 !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
    967 
    968       do j=1,klon
    969         phy_sst(j,i)=248.+55.*(1-sin(rlatd(j))**2)
    970       enddo
     953        PRINT*, 'Profile SST 20'
     954        !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
     955
     956        do j = 1, klon
     957          phy_sst(j, i) = 248. + 55. * (1 - sin(rlatd(j))**2)
     958        enddo
    971959      endif
    972960
    973961      IF (type_profil==21) THEN
    974       PRINT*,'Profile SST 21'
    975 !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
    976       do j=1,klon
    977         phy_sst(j,i)=252.+55.*(1-sin(rlatd(j))**2)
    978       enddo
     962        PRINT*, 'Profile SST 21'
     963        !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
     964        do j = 1, klon
     965          phy_sst(j, i) = 252. + 55. * (1 - sin(rlatd(j))**2)
     966        enddo
    979967      endif
    980968
    981 
    982 
    983969    END DO
    984970
    985971    ! IM beg : verif profil SST: phy_sst
    986     amn = min(phy_sst(1,1), 1000.)
    987     amx = max(phy_sst(1,1), -1000.)
     972    amn = min(phy_sst(1, 1), 1000.)
     973    amx = max(phy_sst(1, 1), -1000.)
    988974    imn = 1
    989975    kmn = 1
    … …  
    992978    DO k = 1, year_len
    993979      DO i = 2, nlon
    994         IF (phy_sst(i,k)<amn) THEN
     980        IF (phy_sst(i, k)<amn) THEN
    995981          amn = phy_sst(i, k)
    996982          imn = i
    997983          kmn = k
    998984        END IF
    999         IF (phy_sst(i,k)>amx) THEN
     985        IF (phy_sst(i, k)>amx) THEN
    1000986          amx = phy_sst(i, k)
    1001987          imx = i
    … …  
    1009995    ! IM end : verif profil SST: phy_sst
    1010996
    1011 
    1012997  END SUBROUTINE profil_sst
    1013998

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyetat0_mod.F90

    r5139 r5144  
    6262#endif
    6363#endif
     64USE lmdz_yomcst
    6465
    6566  IMPLICIT NONE
    … …  
    6970  !======================================================================
    7071  include "dimsoil.h"
    71   include "YOMCST.h"
    7272  !======================================================================
    7373  CHARACTER*(*) fichnom

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90

    r5143 r5144  
    424424    USE lmdz_conema3
    425425    USE lmdz_dimpft, ONLY: nvm_lmdz
    426     USE lmdz_YOETHF
     426    USE lmdz_yoethf
    427427    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
     428    USE lmdz_yomcst
    428429
    429430    IMPLICIT NONE
    … …  
    12681269    REAL :: ro3i ! 0<=ro3i<=360 ; required time index in NetCDF file for
    12691270                 ! the ozone fields, old method.
    1270 
    1271     include "YOMCST.h"
    12721271
    12731272    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90

    r5143 r5144  
    1616#endif
    1717
    18     USE lmdz_YOETHF
     18    USE lmdz_yoethf
    1919    USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep
     20    USE lmdz_yomcst
    2021
    2122    IMPLICIT NONE
    … …  
    3233
    3334    !--------Stochastic Boundary Layer Triggering: ALE_BL--------
    34     !---Propri\'et\'es du thermiques au LCL
    35     include "YOMCST.h"
    36     !IM 100106 BEG : pouvoir sortir les ctes de la physique
    3735
    3836DO ixt=1,1+ntiso
Note: See TracChangeset for help on using the changeset viewer.