Ignore:
Timestamp:
Jul 24, 2024, 2:54:37 PM (2 months ago)
Author:
abarral
Message:

rename modules properly lmdz_*
move ismin, ismax, minmax into new lmdz_libmath.f90
(lint) uppercase fortran keywords

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/inlandsis.f90

    r5113 r5116  
    186186  logical :: BloMod
    187187  logical :: debut
    188   integer :: jjtime
     188  INTEGER :: jjtime
    189189
    190190
    … …  
    195195  ! ---------
    196196
    197   real :: TBr_sv(klonv)                 ! Brightness Temperature
    198   real :: IRdwsv(klonv)                 ! DOWNward   IR Flux
    199   real :: IRupsv(klonv)                 ! UPward     IR Flux
    200   real :: d_Bufs,Bufs_N                 ! Buffer Snow Layer Increment
    201   real :: Buf_ro,Bros_N                 ! Buffer Snow Layer Density
    202   real :: BufPro                        ! Buffer Snow Layer Density
    203   real :: Buf_G1,BG1__N                 ! Buffer Snow Layer Dendr/Sphe[-]
    204   real :: Buf_G2,BG2__N                 ! Buffer Snow Layer Spher/Size[-]
    205   real :: Bdzssv(klonv)                 ! Buffer Snow Layer Thickness
    206   real :: z_snsv(klonv)                 ! Snow-Ice, current Thickness
     197  REAL :: TBr_sv(klonv)                 ! Brightness Temperature
     198  REAL :: IRdwsv(klonv)                 ! DOWNward   IR Flux
     199  REAL :: IRupsv(klonv)                 ! UPward     IR Flux
     200  REAL :: d_Bufs,Bufs_N                 ! Buffer Snow Layer Increment
     201  REAL :: Buf_ro,Bros_N                 ! Buffer Snow Layer Density
     202  REAL :: BufPro                        ! Buffer Snow Layer Density
     203  REAL :: Buf_G1,BG1__N                 ! Buffer Snow Layer Dendr/Sphe[-]
     204  REAL :: Buf_G2,BG2__N                 ! Buffer Snow Layer Spher/Size[-]
     205  REAL :: Bdzssv(klonv)                 ! Buffer Snow Layer Thickness
     206  REAL :: z_snsv(klonv)                 ! Snow-Ice, current Thickness
    207207
    208208
    … …  
    211211  ! -----
    212212
    213   integer :: iwr
    214   integer :: ikl   ,isn   ,isl   ,ist      !
    215   integer :: ist__s,ist__w                 ! Soil/Water Body Identifier
    216   integer :: growth                        ! Seasonal               Mask
    217   integer :: LISmsk                        ! Land+Ice / Open    Sea Mask
    218   integer :: LSnMsk                        ! Snow-Ice / No Snow-Ice Mask
    219   integer :: IceMsk,IcIndx(klonv)          !      Ice / No      Ice Mask
    220   integer :: SnoMsk                        ! Snow     / No Snow     Mask
    221   real :: roSMin,roSMax,roSn_1,roSn_2,roSn_3   ! Fallen Snow Density (PAHAUT)
    222   real :: Dendr1,Dendr2,Dendr3          ! Fallen Snow Dendric.(GIRAUD)
    223   real :: Spher1,Spher2,Spher3,Spher4   ! Fallen Snow Spheric.(GIRAUD)
    224   real :: Polair                        ! Polar  Snow Switch
    225   real :: PorSno,Salt_f,PorRef   !
     213  INTEGER :: iwr
     214  INTEGER :: ikl   ,isn   ,isl   ,ist      !
     215  INTEGER :: ist__s,ist__w                 ! Soil/Water Body Identifier
     216  INTEGER :: growth                        ! Seasonal               Mask
     217  INTEGER :: LISmsk                        ! Land+Ice / Open    Sea Mask
     218  INTEGER :: LSnMsk                        ! Snow-Ice / No Snow-Ice Mask
     219  INTEGER :: IceMsk,IcIndx(klonv)          !      Ice / No      Ice Mask
     220  INTEGER :: SnoMsk                        ! Snow     / No Snow     Mask
     221  REAL :: roSMin,roSMax,roSn_1,roSn_2,roSn_3   ! Fallen Snow Density (PAHAUT)
     222  REAL :: Dendr1,Dendr2,Dendr3          ! Fallen Snow Dendric.(GIRAUD)
     223  REAL :: Spher1,Spher2,Spher3,Spher4   ! Fallen Snow Spheric.(GIRAUD)
     224  REAL :: Polair                        ! Polar  Snow Switch
     225  REAL :: PorSno,Salt_f,PorRef   !
    226226  ! #sw real      PorVol,rWater                 !
    227227  ! #sw real      rusNEW,rdzNEW,etaNEW          !
    228   real :: ro_new                        !
    229   real :: TaPole                        ! Maximum     Polar Temperature
    230   real :: T__Min                        ! Minimum realistic Temperature
    231   real :: EmiSol                        ! Emissivity of       Soil
    232   real :: EmiSno                        ! Emissivity of            Snow
    233   real :: EmiWat                        ! Emissivity of a Water Area
    234   real :: vk2                           ! Square of Von Karman Constant
    235   real :: u2star                        !(u*)**2
    236   real :: Z0mLnd                        !          Land Roughness Length
     228  REAL :: ro_new                        !
     229  REAL :: TaPole                        ! Maximum     Polar Temperature
     230  REAL :: T__Min                        ! Minimum realistic Temperature
     231  REAL :: EmiSol                        ! Emissivity of       Soil
     232  REAL :: EmiSno                        ! Emissivity of            Snow
     233  REAL :: EmiWat                        ! Emissivity of a Water Area
     234  REAL :: vk2                           ! Square of Von Karman Constant
     235  REAL :: u2star                        !(u*)**2
     236  REAL :: Z0mLnd                        !          Land Roughness Length
    237237  ! #ZN real      sqrrZ0                        ! u*t/u*
    238   real :: f_eff                         ! Marticorena & B. 1995 JGR (20)
    239   real :: A_Fact                        ! Fundamental * Roughness
    240   real :: Z0m_nu                        ! Smooth R Snow Roughness Length
    241   real :: Z0mBSn                        !         BSnow Roughness Length
    242   real :: Z0mBS0                        ! Mimimum BSnow Roughness Length
    243   real :: Z0m_S0                        ! Mimimum  Snow Roughness Length
    244   real :: Z0m_S1                        ! Maximum  Snow Roughness Length
     238  REAL :: f_eff                         ! Marticorena & B. 1995 JGR (20)
     239  REAL :: A_Fact                        ! Fundamental * Roughness
     240  REAL :: Z0m_nu                        ! Smooth R Snow Roughness Length
     241  REAL :: Z0mBSn                        !         BSnow Roughness Length
     242  REAL :: Z0mBS0                        ! Mimimum BSnow Roughness Length
     243  REAL :: Z0m_S0                        ! Mimimum  Snow Roughness Length
     244  REAL :: Z0m_S1                        ! Maximum  Snow Roughness Length
    245245  ! #SZ real      Z0Sa_N                        ! Regime   Snow Roughness Length
    246246  ! #SZ real      Z0SaSi                        ! 1.IF Rgm Snow Roughness Length
    247247  ! #GL real      Z0_GIM                        ! Mimimum GIMEX Roughness Length
    248   real :: Z0_ICE                        ! Ice ISW   Roughness Length
    249   real :: Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
    250   real :: SnoWat                        ! Snow Layer    Switch
    251   real :: rstar,alors                   !
    252   real :: rstar0,rstar1,rstar2          !
    253   real :: SameOK                        ! 1. => Same Type of Grains
    254   real :: G1same                        ! Averaged G1,  same Grains
    255   real :: G2same                        ! Averaged G2,  same Grains
    256   real :: typ__1                        ! 1. => Lay1 Type: Dendritic
    257   real :: zroNEW                        ! dz X ro, if fresh Snow
    258   real :: G1_NEW                        ! G1,      if fresh Snow
    259   real :: G2_NEW                        ! G2,      if fresh Snow
    260   real :: zroOLD                        ! dz X ro, if old   Snow
    261   real :: G1_OLD                        ! G1,      if old   Snow
    262   real :: G2_OLD                        ! G2,      if old   Snow
    263   real :: SizNEW                        ! Size,    if fresh Snow
    264   real :: SphNEW                        ! Spheric.,if fresh Snow
    265   real :: SizOLD                        ! Size,    if old   Snow
    266   real :: SphOLD                        ! Spheric.,if old   Snow
    267   real :: Siz_av                        ! Averaged    Grain Size
    268   real :: Sph_av                        ! Averaged    Grain Spher.
    269   real :: Den_av                        ! Averaged    Grain Dendr.
    270   real :: G1diff                        ! Averaged G1, diff. Grains
    271   real :: G2diff                        ! Averaged G2, diff. Grains
    272   real :: G1                            ! Averaged G1
    273   real :: G2                            ! Averaged G2
    274   real :: param                         ! Polynomial   fit z0=f(T)
    275   real :: Z0_obs                        ! Fit Z0_obs=f(T) (m)
    276   real :: tamin                         ! min T of linear fit (K)
    277   real :: tamax                         ! max T of linear fit (K)
    278   real :: coefa,coefb,coefc,coefd       ! Coefs for z0=f(T)
    279   real :: ta1,ta2,ta3                   ! Air temperature thresholds
    280   real :: z01,z02,z03                   ! z0 thresholds
    281   real :: tt_c,vv_c                     ! Critical param.
    282   real :: tt_tmp,vv_tmp,vv_virt         ! Temporary variables
    283   real :: e_prad,e1pRad,A_Rad0,absg_V,absgnI,exdRad ! variables for SoSosv calculations
    284   real :: zm1, zm2, coefslope                    ! variables for surface temperature extrapolation
     248  REAL :: Z0_ICE                        ! Ice ISW   Roughness Length
     249  REAL :: Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
     250  REAL :: SnoWat                        ! Snow Layer    Switch
     251  REAL :: rstar,alors                   !
     252  REAL :: rstar0,rstar1,rstar2          !
     253  REAL :: SameOK                        ! 1. => Same Type of Grains
     254  REAL :: G1same                        ! Averaged G1,  same Grains
     255  REAL :: G2same                        ! Averaged G2,  same Grains
     256  REAL :: typ__1                        ! 1. => Lay1 Type: Dendritic
     257  REAL :: zroNEW                        ! dz X ro, if fresh Snow
     258  REAL :: G1_NEW                        ! G1,      if fresh Snow
     259  REAL :: G2_NEW                        ! G2,      if fresh Snow
     260  REAL :: zroOLD                        ! dz X ro, if old   Snow
     261  REAL :: G1_OLD                        ! G1,      if old   Snow
     262  REAL :: G2_OLD                        ! G2,      if old   Snow
     263  REAL :: SizNEW                        ! Size,    if fresh Snow
     264  REAL :: SphNEW                        ! Spheric.,if fresh Snow
     265  REAL :: SizOLD                        ! Size,    if old   Snow
     266  REAL :: SphOLD                        ! Spheric.,if old   Snow
     267  REAL :: Siz_av                        ! Averaged    Grain Size
     268  REAL :: Sph_av                        ! Averaged    Grain Spher.
     269  REAL :: Den_av                        ! Averaged    Grain Dendr.
     270  REAL :: G1diff                        ! Averaged G1, diff. Grains
     271  REAL :: G2diff                        ! Averaged G2, diff. Grains
     272  REAL :: G1                            ! Averaged G1
     273  REAL :: G2                            ! Averaged G2
     274  REAL :: param                         ! Polynomial   fit z0=f(T)
     275  REAL :: Z0_obs                        ! Fit Z0_obs=f(T) (m)
     276  REAL :: tamin                         ! min T of linear fit (K)
     277  REAL :: tamax                         ! max T of linear fit (K)
     278  REAL :: coefa,coefb,coefc,coefd       ! Coefs for z0=f(T)
     279  REAL :: ta1,ta2,ta3                   ! Air temperature thresholds
     280  REAL :: z01,z02,z03                   ! z0 thresholds
     281  REAL :: tt_c,vv_c                     ! Critical param.
     282  REAL :: tt_tmp,vv_tmp,vv_virt         ! Temporary variables
     283  REAL :: e_prad,e1pRad,A_Rad0,absg_V,absgnI,exdRad ! variables for SoSosv calculations
     284  REAL :: zm1, zm2, coefslope                    ! variables for surface temperature extrapolation
    285285  ! for Aeolian erosion and blowing snow
    286   integer :: nit   ,iit
    287   real :: Fac                           ! Correc. factor for drift ratio
    288   real :: dusuth,signus
    289   real :: sss__F,sss__N
    290   real :: sss__K,sss__G
    291   real :: us_127,us_227,us_327,us_427,us_527
    292   real :: VVa_OK, usuth0
    293   real :: ssstar
    294   real :: SblPom
    295   real :: rCd10n                        ! Square root of drag coefficient
    296   real :: DendOK                        ! Dendricity Switch
    297   real :: SaltOK                        ! Saltation  Switch
    298   real :: MeltOK                        ! Saltation  Switch (Melting Snow)
    299   real :: SnowOK                        ! Pack Top   Switch
    300   real :: SaltM1,SaltM2,SaltMo,SaltMx   ! Saltation  Parameters
    301   real :: ShearX, ShearS                ! Arg. Max Shear Stress
    302   real :: Por_BS                        ! Snow Porosity
    303   real :: Salt_us                       ! New thresh.friction velocity u*t
    304   real :: Fac_Mo,ArguSi,FacRho          ! Numerical factors for u*t
    305   real :: SaltSI(klonv,0:nsno)          ! Snow Drift Index              !
    306   real :: MIN_Mo                        ! Minimum Mobility Fresh Fallen *
    307   character(len=3) :: qsalt_param              ! Switch for saltation flux param.
    308   character(len=3) :: usth_param               ! Switch for u*t param
     286  INTEGER :: nit   ,iit
     287  REAL :: Fac                           ! Correc. factor for drift ratio
     288  REAL :: dusuth,signus
     289  REAL :: sss__F,sss__N
     290  REAL :: sss__K,sss__G
     291  REAL :: us_127,us_227,us_327,us_427,us_527
     292  REAL :: VVa_OK, usuth0
     293  REAL :: ssstar
     294  REAL :: SblPom
     295  REAL :: rCd10n                        ! Square root of drag coefficient
     296  REAL :: DendOK                        ! Dendricity Switch
     297  REAL :: SaltOK                        ! Saltation  Switch
     298  REAL :: MeltOK                        ! Saltation  Switch (Melting Snow)
     299  REAL :: SnowOK                        ! Pack Top   Switch
     300  REAL :: SaltM1,SaltM2,SaltMo,SaltMx   ! Saltation  Parameters
     301  REAL :: ShearX, ShearS                ! Arg. Max Shear Stress
     302  REAL :: Por_BS                        ! Snow Porosity
     303  REAL :: Salt_us                       ! New thresh.friction velocity u*t
     304  REAL :: Fac_Mo,ArguSi,FacRho          ! Numerical factors for u*t
     305  REAL :: SaltSI(klonv,0:nsno)          ! Snow Drift Index              !
     306  REAL :: MIN_Mo                        ! Minimum Mobility Fresh Fallen *
     307  CHARACTER(LEN=3) :: qsalt_param              ! Switch for saltation flux param.
     308  CHARACTER(LEN=3) :: usth_param               ! Switch for u*t param
    309309
    310310
    … …  
    409409    IF (BloMod) THEN
    410410
    411     if (klonv==1) then
    412       if(isnoSV(1)>=2                   .and. &
     411    if (klonv==1) THEN
     412      IF(isnoSV(1)>=2                   .and. &
    413413            TsisSV(1,max(1,isnoSV(1)))<273.  .and. &
    414414            ro__SV(1,max(1,isnoSV(1)))<500.  .and. &
    415             eta_SV(1,max(1,isnoSV(1)))<epsi) then
     415            eta_SV(1,max(1,isnoSV(1)))<epsi) THEN
    416416  ! +                       **********
    417417                 CALL SISVAT_BSn
    … …  
    508508  ! +--Threshold Friction Velocity
    509509  ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    510       if(ro__SV(ikl,isn)>300.) then
     510      IF(ro__SV(ikl,isn)>300.) THEN
    511511         Por_BS      =  1.000       - ro__SV(ikl,isn)     /ro_Ice
    512512      else
    … …  
    518518  ! +     Gallee et al., 2001    eq 5, p5
    519519
    520       if (usth_param == "gal") then
     520      if (usth_param == "gal") THEN
    521521        Salt_us   =   (log(2.868) - log(1 + SaltMo)) * rCd10n/0.085
    522522        Salt_us   = Salt_us * Fac_Mo
    … …  
    526526
    527527      if (usth_param == "lis") then !Liston et al. 2007
    528         if(ro__SV(ikl,isn)>300.) then
     528        IF(ro__SV(ikl,isn)>300.) THEN
    529529          Salt_us   = 0.005*exp(0.013*ro__SV(ikl,isn))
    530530        else
    … …  
    607607    hSalSV(ikl) = 8.436e-2  * us__SV(ikl)**SblPom
    608608
    609     if (qsalt_param == "pom") then
     609    if (qsalt_param == "pom") THEN
    610610      qSalSV(ikl) = (us__SV(ikl)**2 - usthSV(ikl)**2) *signus &
    611611            / (hSalSV(ikl) * gravit * us__SV(ikl) * 3.25)
    612612    endif
    613613
    614     if (qsalt_param == "bin") then
     614    if (qsalt_param == "bin") THEN
    615615      qSalSV(ikl) = (us__SV(ikl) * us__SV(ikl) &
    616616            -usthSV(ikl) * usthSV(ikl))*signus &
    … …  
    662662  ! #BS       density_kotlyakov = .FALSE.  !C.Amory BS 2018
    663663  ! + ...     Fallen Snow Density, Adapted for Antarctica
    664         if (is_ok_density_kotlyakov) then
     664        if (is_ok_density_kotlyakov) THEN
    665665            tt_tmp = TaT_SV(ikl)-TfSnow
    666666            !vv_tmp = VV10SV(ikl)
    … …  
    668668  ! + ...         [ A compromise between
    669669  ! + ...           Kotlyakov (1961) and Lenaerts (2012, JGR, Part1) ]
    670             if (tt_tmp>=-10) then
     670            if (tt_tmp>=-10) THEN
    671671              BufPro   =  max( rosMin, &
    672672                    104. *sqrt( max( vv_tmp-6.0,0.0))) ! Kotlyakov (1961)
    … …  
    696696  !    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    697697
    698      if (BloMod) then
     698     if (BloMod) THEN
    699699     Bros_N      = frsno
    700700     ro_new      = ro__SV(ikl,max(1,isnoSV(ikl)))
    … …  
    894894
    895895
    896   if (discret_xf.AND.klonv==1) then
    897 
    898    if(isnoSV(1)>=1.or.NLaysv(1)>=1) then
     896  if (discret_xf.AND.klonv==1) THEN
     897   IF(isnoSV(1)>=1.or.NLaysv(1)>=1) THEN
    899898  ! +          **********
    900899     CALL SISVAT_zSn
    … …  
    10811080
    10821081
    1083   if (iflag_temp_inlandsis == 0) then
    1084 
     1082  if (iflag_temp_inlandsis == 0) THEN
    10851083   CALL SISVAT_TSo
    10861084
    … …  
    12051203  ! Etienne: extrapolation from the two uppermost levels:
    12061204
    1207      if (isnoSV(ikl) >=2) then
     1205     if (isnoSV(ikl) >=2) THEN
    12081206       zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
    12091207       zm2=-(dzsnSV(ikl,isnoSV(ikl)) + dzsnSV(ikl,isnoSV(ikl)-1)/2.)
    1210      else if (isnoSV(ikl) == 1) then
     1208     else if (isnoSV(ikl) == 1) THEN
    12111209       zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
    12121210       zm2=-(dzsnSV(ikl,isnoSV(ikl))+dz_dSV(0)/2.)
    … …  
    12361234  IF (SnoMod)                                                 THEN
    12371235
    1238   if (discret_xf .AND. klonv==1) then
    1239   if(isnoSV(1)>=1) then
     1236  if (discret_xf .AND. klonv==1) THEN
     1237  IF(isnoSV(1)>=1) THEN
    12401238  ! +          **********
    12411239  CALL SISVAT_GSn
    … …  
    13361334      coefd = log(z03)-coefc*ta3
    13371335
    1338       if (TaT_SV(ikl) < ta1) then
     1336      if (TaT_SV(ikl) < ta1) THEN
    13391337        Z0_obs = z01
    1340       else if (TaT_SV(ikl)>=ta1 .and. TaT_SV(ikl)<ta2) then
     1338      else if (TaT_SV(ikl)>=ta1 .and. TaT_SV(ikl)<ta2) THEN
    13411339        Z0_obs = exp(coefa*TaT_SV(ikl) + coefb)
    1342       else if (TaT_SV(ikl)>=ta2 .and. TaT_SV(ikl)<ta3) then
     1340      else if (TaT_SV(ikl)>=ta2 .and. TaT_SV(ikl)<ta3) THEN
    13431341        ! if st > 0, melting induce smooth surface
    13441342        Z0_obs = exp(coefc*TaT_SV(ikl) + coefd)
    … …  
    14721470  !XF    MAR is then too warm and not enough melt
    14731471
    1474      if(ro__SV(ikl,isnoSV(ikl))>50 &
    1475            .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)then
    1476 
     1472     IF(ro__SV(ikl,isnoSV(ikl))>50 &
     1473           .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)THEN
    14771474         Z0hnSV(ikl) = max(zero &
    14781475               , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)) &
    … …  
    14971494
    14981495
    1499 end subroutine inlandsis
    1500 
    1501 
    1502 
    1503 
    1504 
    1505 
    1506 
    1507 
    1508 
    1509 
    1510 
     1496END SUBROUTINE inlandsis
     1497
     1498
     1499
     1500
     1501
     1502
     1503
     1504
     1505
     1506
     1507
Note: See TracChangeset for help on using the changeset viewer.