Ignore:
Timestamp:
Nov 28, 2025, 5:34:54 PM (2 months ago)
Author:
Sebastien Nguyen
Message:

rephase LMDZISO with 5864 version of phylmd + bug fixes in physiq_mod + other bugs in isoverif sections. Code now compiles and runs with -debug -isotopes true -isoverif. There are still isoverif error messages for Dexcess getting greater than 1000 on some points at some moments.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmdiso/phyetat0_mod.F90

    r5662 r5894  
    1 ! $Id: phyetat0.F90 3890 2021-05-05 15:15:06Z jyg $
     1! $Id: phyetat0_mod.f90 5776 2025-07-15 12:13:19Z evignon $
    22
    33MODULE phyetat0_mod
    … …  
    1010SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
    1111
    12   USE dimphy, only: klon, zmasq, klev
     12  USE clesphys_mod_h
     13  USE dimphy, only: klon, zmasq, klev, nbtersrf, nbtsoildepths
    1314  USE iophy, ONLY : init_iophy_new
    1415  USE ocean_cpl_mod,    ONLY : ocean_cpl_init
    … …  
    1920  USE pbl_surface_mod,  ONLY : pbl_surface_init_iso
    2021#endif
    21   USE phyetat0_get_mod, ONLY : phyetat0_get, phyetat0_srf
    2222!GG  USE surface_data,     ONLY : type_ocean, version_ocean
    2323  USE surface_data,     ONLY : type_ocean, version_ocean, iflag_seaice, &
    2424                                   iflag_seaice_alb, iflag_leads
    2525!GG
     26  USE phyetat0_get_mod, ONLY : phyetat0_get, phyetat0_srf
    2627  USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, phys_tstep, &
    2728       qsol, fevap, z0m, z0h, agesno, &
    … …  
    2930       falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, &
    3031       ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, &
    31        cf_ancien, rvc_ancien, radpas, radsol, rain_fall, ratqs, &
     32       cf_ancien, rvc_ancien, tke_ancien, radpas, radsol, rain_fall, ratqs, &
    3233       rnebcon, rugoro, sig1, snow_fall, bs_fall, solaire_etat0, sollw, sollwdown, &
    3334       solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
    … …  
    3536       wake_s, awake_s, wake_dens, awake_dens, cv_gen, zgam, zmax0, zmea, zpic, zsig, &
    3637#ifdef ISO
    37        fxtevap, xtsol, xt_ancien, xtl_ancien, xts_ancien, wake_deltaxt, &
     38       fxtevap, xtsol, xt_ancien, xtl_ancien, xts_ancien, xtbs_ancien, wake_deltaxt, &
    3839       xtrain_fall,xtsnow_fall, &
    3940#endif
    … …  
    4243!GG       dt_ds, ratqs_inter_
    4344       dt_ds, ratqs_inter_, &
    44        hice, tice, bilg_cumul
     45       hice, tice, bilg_cumul, &
    4546!GG
    46 
     47       frac_tersrf, z0m_tersrf, ratio_z0m_z0h_tersrf, &
     48       albedo_tersrf, beta_tersrf, inertie_tersrf, alpha_soil_tersrf, &
     49       period_tersrf, hcond_tersrf, tsurfi_tersrf, tsoili_tersrf, tsoil_depth, &
     50       qsurf_tersrf, tsurf_tersrf, tsoil_tersrf, tsurf_new_tersrf, cdragm_tersrf, &
     51       cdragh_tersrf, swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf
    4752!FC
    4853  USE geometry_mod,     ONLY: longitude_deg, latitude_deg
    … …  
    5762  !GG
    5863  USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
    59   use wxios_mod, ONLY: missing_val_xios => missing_val, using_xios
    60   use netcdf, only: missing_val_netcdf => nf90_fill_real
    61   use config_ocean_skin_m, only: activate_ocean_skin
     64  USE wxios_mod, ONLY: missing_val_xios => missing_val, using_xios
     65  USE netcdf, only: missing_val_netcdf => nf90_fill_real
     66  USE config_ocean_skin_m, only: activate_ocean_skin
     67  USE surf_param_mod, ONLY: average_surf_var, interpol_tsoil !AM
    6268#ifdef ISO
    6369  USE infotrac_phy, ONLY: niso
    … …  
    6874#endif
    6975#endif
    70   USE clesphys_mod_h
    7176  USE dimsoil_mod_h, ONLY: nsoilmx
    72 
    7377  USE yomcst_mod_h
    7478  USE alpale_mod
    7579  USE compbl_mod_h
    76 IMPLICIT none
     80
     81  IMPLICIT NONE
     82
    7783  !======================================================================
    7884  ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
    7985  ! Objet: Lecture de l'etat initial pour la physique
    80   !======================================================================  !======================================================================
     86  !======================================================================
    8187  CHARACTER*(*) fichnom
    8288
    … …  
    342348!===================================================================
    343349
    344    if ( iflag_physiq <= 1 ) then
     350   IF ( iflag_physiq <= 1 ) THEN
    345351!===================================================================
    346352  ! Lecture des temperatures du sol profond:
    … …  
    376382     bs_fall(:)=0.
    377383  ENDIF
    378 
    379384
    380385!=======================================================================
    … …  
    424429  ENDIF
    425430
    426   endif ! iflag_physiq <= 1
     431  IF (iflag_hetero_surf .GT. 0) THEN
     432    found=phyetat0_srf(frac_tersrf,"frac_tersrf","fraction of continental sub-surfaces",0.)
     433    found=phyetat0_srf(z0m_tersrf,"z0m_tersrf","roughness length for momentum of continental sub-surfaces",0.)
     434    found=phyetat0_srf(ratio_z0m_z0h_tersrf,"ratio_z0m_z0h_tersrf","ratio of heat to momentum roughness length of continental sub-surfaces",0.)
     435    found=phyetat0_srf(albedo_tersrf,"albedo_tersrf","albedo of continental sub-surfaces",0.)
     436    found=phyetat0_srf(beta_tersrf,"beta_tersrf","evapotranspiration coef of continental sub-surfaces",0.)
     437    found=phyetat0_srf(inertie_tersrf,"inertie_tersrf","soil thermal inertia of continental sub-surfaces",0.)
     438    found=phyetat0_srf(hcond_tersrf,"hcond_tersrf","heat conductivity of continental sub-surfaces",0.)
     439    found=phyetat0_srf(tsurfi_tersrf,"tsurfi_tersrf","initial surface temperature of continental sub-surfaces",0.)
     440    !
     441    ! Check if the sum of the sub-surface fractions is equal to 1
     442    DO it=1,klon
     443      IF (SUM(frac_tersrf(it,:)) .NE. 1.) THEN
     444        PRINT*, 'SUM(frac_tersrf) = ', SUM(frac_tersrf(it,:))
     445        CALL abort_physic('conf_phys', 'the sum of fractions of heterogeneous land subsurfaces must be equal &
     446                          & to 1 for iflag_hetero_surf = 1 and 2',1)
     447      ENDIF
     448    ENDDO
     449    !
     450    ! Initialisation of surface and soil temperatures (potentially different initial temperatures between sub-surfaces)
     451    DO iq=1,nbtersrf
     452      DO it=1,klon
     453        tsurf_tersrf(it,iq) = tsurfi_tersrf(it,iq)
     454      ENDDO
     455    ENDDO
     456    !
     457    DO isoil=1, nbtsoildepths
     458      IF (isoil.GT.99) THEN
     459        PRINT*, "Trop de couches "
     460        CALL abort_physic("phyetat0", "", 1)
     461      ENDIF
     462      WRITE(str2,'(i2.2)') isoil
     463      found=phyetat0_srf(tsoil_depth(:,isoil,:),"tsoil_depth"//str2//"srf","soil depth of continental sub-surfaces",0.)
     464      found=phyetat0_srf(tsoili_tersrf(:,isoil,:),"Tsoili"//str2//"srf","initial soil temperature of continental sub-surfaces",0.)
     465      IF (.NOT. found) THEN
     466        PRINT*, "phyetat0: Le champ <Tsoili"//str2//"> est absent"
     467        PRINT*, "          Il prend donc la valeur de surface"
     468        tsoili_tersrf(:, isoil, :) = tsurfi_tersrf(:, :)
     469      ENDIF
     470    ENDDO
     471    !
     472    tsoil_tersrf = interpol_tsoil(klon, nbtersrf, nsoilmx, nbtsoildepths, alpha_soil_tersrf, period_tersrf, &
     473                   inertie_tersrf, hcond_tersrf, tsoil_depth, tsurf_tersrf, tsoili_tersrf)
     474    !
     475    ! initialise also average surface and soil temperatures
     476    ftsol(:,is_ter) = average_surf_var(klon, nbtersrf, tsurf_tersrf, frac_tersrf, 'ARI')
     477    DO k=1, nsoilmx
     478      tsoil(:,k,is_ter) = average_surf_var(klon, nbtersrf, tsoil_tersrf(:,k,:), frac_tersrf, 'ARI')
     479    ENDDO
     480    !
     481  ENDIF ! iflag_hetero_surf > 0
     482
     483  ENDIF ! iflag_physiq <= 1
    427484
    428485  ! Lecture de l'age de la neige:
    429486  found=phyetat0_srf(agesno,"AGESNO","SNOW AGE",0.001)
    430487
    431   ancien_ok=.true.
     488  ancien_ok=.TRUE.
    432489  ancien_ok=ancien_ok.AND.phyetat0_get(t_ancien,"TANCIEN","TANCIEN",0.)
    433490  ancien_ok=ancien_ok.AND.phyetat0_get(q_ancien,"QANCIEN","QANCIEN",0.)
    … …  
    442499  ! cas specifique des variables de la neige soufflee
    443500  IF (ok_bs) THEN
    444      ancien_ok=ancien_ok.AND.phyetat0_get(qbs_ancien,"QBSANCIEN","QBSANCIEN",0.)
    445      ancien_ok=ancien_ok.AND.phyetat0_get(prbsw_ancien,"PRBSWANCIEN","PRBSWANCIEN",0.)
     501    ancien_ok=ancien_ok.AND.phyetat0_get(qbs_ancien,"QBSANCIEN","QBSANCIEN",0.)
     502    ancien_ok=ancien_ok.AND.phyetat0_get(prbsw_ancien,"PRBSWANCIEN","PRBSWANCIEN",0.)
    446503  ELSE
    447      qbs_ancien(:,:)=0.
    448      prbsw_ancien(:)=0.
     504    qbs_ancien(:,:)=0.
     505    prbsw_ancien(:)=0.
     506#ifdef ISO
     507    xtbs_ancien(:,:,:)=0.
     508#endif
    449509  ENDIF
    450510 
    … …  
    468528       (maxval(prsw_ancien).EQ.minval(prsw_ancien)) .OR. &
    469529       (maxval(t_ancien).EQ.minval(t_ancien)) ) THEN
    470     ancien_ok=.false.
     530    ancien_ok=.FALSE.
    471531  ENDIF
    472532
    … …  
    474534    IF ( (maxval(qbs_ancien).EQ.minval(qbs_ancien))       .OR. &
    475535         (maxval(prbsw_ancien).EQ.minval(prbsw_ancien)) ) THEN
    476        ancien_ok=.false.
     536      ancien_ok=.FALSE.
    477537    ENDIF
    478538  ENDIF
    … …  
    481541    IF ( (maxval(cf_ancien).EQ.minval(cf_ancien))     .OR. &
    482542         (maxval(rvc_ancien).EQ.minval(rvc_ancien)) ) THEN
    483        ancien_ok=.false.
    484      ENDIF
     543      ancien_ok=.FALSE.
     544    ENDIF
    485545  ENDIF
    486546
    … …  
    495555!==================================
    496556!
    497   IF (iflag_pbl>1) then
    498      found=phyetat0_srf(pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
    499   ENDIF
    500 
    501   IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
     557  ! cas specifique de l'advection de TKE
     558  IF (ok_advtke) THEN
     559    ancien_ok=ancien_ok.AND.phyetat0_get(tke_ancien,"TKEANCIEN","TKEANCIEN",0.)
     560  ELSE
     561    tke_ancien(:,:)=0.
     562  ENDIF
     563
     564  IF (ok_advtke) THEN
     565    IF ( (maxval(tke_ancien).EQ.minval(tke_ancien))) THEN
     566      ancien_ok=.FALSE.
     567    ENDIF
     568  ENDIF
     569
     570  IF ((iflag_pbl>1)) THEN
     571    found=phyetat0_srf(pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
     572  ENDIF
     573
     574  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) THEN
    502575    found=phyetat0_srf(wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
    503576!!    found=phyetat0_srf(delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
    … …  
    573646
    574647#ifdef ISO
    575         ! initialise les isotopes       
    576         write(*,*) 'phyetat0 1069'
    577          CALL phyisoetat0 (snow,run_off_lic_0, &
    578      &           xtsnow,xtrun_off_lic_0, &
    579      &           Rland_ice)
     648     ! initialise les isotopes       
     649  WRITE(*,*) 'phyetat0 1069'
     650  CALL phyisoetat0 (snow,run_off_lic_0, &
     651  &           xtsnow,xtrun_off_lic_0, &
     652  &           Rland_ice)
    580653#ifdef ISOVERIF
    581       write(*,*) 'phyetat0 1074'
    582       if (iso_eau.gt.0) then
    583       call iso_verif_egalite_vect2D(  &
    584      &           xtsnow,snow, &
    585      &           'phyetat0 1101a',niso,klon,nbsrf)
    586         do i=1,klon 
    587               call iso_verif_egalite(Rland_ice(iso_eau,i),1.0, &
    588      &         'phyetat0 1101b')
    589          enddo
    590       endif
    591       write(*,*) 'phyetat0 1102'
     654  WRITE(*,*) 'phyetat0 1074'
     655  IF (iso_eau.GT.0) THEN
     656    CALL iso_verif_egalite_vect2D(  &
     657    &           xtsnow,snow, &
     658    &           'phyetat0 1101a',niso,klon,nbsrf)
     659    DO i=1,klon 
     660      CALL iso_verif_egalite(Rland_ice(iso_eau,i),1.0, &
     661      &         'phyetat0 1101b')
     662    ENDDO
     663  ENDIF
     664  WRITE(*,*) 'phyetat0 1102'
    592665#endif
    593666#endif
    … …  
    600673  IF (ok_gwd_rando) found = &
    601674       phyetat0_get(du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
    602   IF (.NOT. ok_hines .AND. ok_gwd_rando) found &
    603        = phyetat0_get(du_gwd_front,"du_gwd_front","du_gwd_front",0.)
     675  IF (.NOT. ok_hines .AND. ok_gwd_rando) found = &
     676       phyetat0_get(du_gwd_front,"du_gwd_front","du_gwd_front",0.)
    604677
    605678!  prise en compte du relief sous-maille
    … …  
    746819  CALL fonte_neige_init(run_off_lic_0)
    747820#ifdef ISO
    748    CALL fonte_neige_init_iso(xtrun_off_lic_0)
     821  CALL fonte_neige_init_iso(xtrun_off_lic_0)
    749822#endif
    750823
Note: See TracChangeset for help on using the changeset viewer.