Ignore:
Timestamp:
Jul 5, 2024, 4:38:48 PM (2 months ago)
Author:
Sebastien Nguyen
Message:

include ISO keys in pbl_surface and associated routines in phylmd

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/phylmd/surf_land_bucket_mod.F90

    r3974 r5022  
    1616       snow, qsol, agesno, tsoil, &
    1717       qsurf, z0_new, alb1_new, alb2_new, evap, &
    18        fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
     18       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
     19#ifdef ISO
     20       ,xtprecip_rain, xtprecip_snow,xtspechum, &
     21       xtsnow, xtsol,xtevap,h1, &
     22       runoff_diag,xtrunoff_diag,Rland_ice &
     23#endif           
     24            )
    1925
    2026    USE limit_read_mod
     
    2834    USE mod_phys_lmdz_para
    2935    USE indice_sol_mod
     36#ifdef ISO
     37    use infotrac_phy, ONLY: ntiso,niso
     38    USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
     39        ridicule_qsol
     40    USE isotopes_routines_mod, ONLY: calcul_iso_surf_ter_vectall
     41#ifdef ISOVERIF
     42    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_noNaN, &
     43        iso_verif_aberrant_o17,iso_verif_egalite_choix,iso_verif_egalite
     44#endif
     45#endif
    3046!****************************************************************************************
    3147! Bucket calculations for surface.
     
    5268    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
    5369    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
     70#ifdef ISO
     71    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
     72    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum   
     73#endif
    5474
    5575! In/Output variables
     
    5878    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
    5979    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
     80#ifdef ISO
     81    REAL, DIMENSION(niso,klon), INTENT(INOUT)       :: xtsnow,xtsol
     82#endif
    6083
    6184! Output variables
     
    6790    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    6891    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
     92#ifdef ISO
     93    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
     94    REAL, DIMENSION(klon),       INTENT(OUT) :: h1
     95    REAL, DIMENSION(niso,klon),  INTENT(OUT) :: xtrunoff_diag
     96    REAL, DIMENSION(klon),       INTENT(OUT) :: runoff_diag
     97    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
     98#endif
    6999
    70100! Local variables
     
    78108    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow
    79109    INTEGER               :: i
    80 !
    81 !****************************************************************************************
    82 
     110#ifdef ISO
     111    INTEGER               :: ixt
     112    REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
     113    REAL, DIMENSION(klon) :: snow_prec,qsol_prec
     114    REAL, PARAMETER       :: t_coup = 273.15
     115    REAL, DIMENSION(klon) :: fq_fonte_diag
     116    REAL, DIMENSION(klon) :: fqfonte_diag
     117    REAL, DIMENSION(klon) :: snow_evap_diag
     118    REAL, DIMENSION(klon) :: fqcalving_diag
     119    REAL                  :: max_eau_sol_diag 
     120    REAL, DIMENSION(klon) :: run_off_lic_diag
     121    REAL :: coeff_rel_diag
     122#endif
     123!
     124!****************************************************************************************
     125
     126#ifdef ISO
     127#ifdef ISOVERIF
     128        !write(*,*) 'surf_land_bucket 152'
     129        DO i=1,knon
     130          IF (iso_eau > 0) THEN
     131            CALL iso_verif_egalite_choix(precip_snow(i), &
     132     &                                   xtprecip_snow(iso_eau,i),'surf_land_bucket 131', &
     133     &                                   errmax,errmaxrel)
     134            CALL iso_verif_egalite_choix(qsol(i), &
     135     &                                   xtsol(iso_eau,i),'surf_land_bucket 134', &
     136     &                                   errmax,errmaxrel)
     137          ENDIF
     138        ENDDO
     139#endif
     140#ifdef ISOVERIF
     141        DO i=1,knon
     142          DO ixt=1,niso
     143            CALL iso_verif_noNaN(xtsol(ixt,i),'surf_land_mod_bucket 142')
     144          ENDDO !do ixt=1,niso
     145        ENDDO !do i=1,knon
     146        !write(*,*) 'surf_land_bucket 152'
     147#endif
     148#endif
    83149
    84150!
     
    131197         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    132198   
     199#ifdef ISO
     200   ! verif
     201#ifdef ISOVERIF
     202    !write(*,*) 'surf_land_bucket 211'
     203    DO i=1,knon
     204      IF (iso_eau > 0) THEN
     205        CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
     206     &           snow(i),'surf_land_bucket 522', &
     207     &           errmax,errmaxrel)
     208      ENDIF !IF (iso_eau > 0) then
     209    ENDDO !DO i=1,knon
     210#endif
     211   ! end verif
     212#endif         
     213#ifdef ISO
     214    DO i=1,knon
     215      snow_prec(i)=snow(i)
     216      qsol_prec(i)=qsol(i)
     217      DO ixt=1,niso
     218        xtsnow_prec(ixt,i)=xtsnow(ixt,i)
     219        xtsol_prec(ixt,i) =xtsol(ixt,i)
     220      ENDDO !DO ixt=1,niso
     221      ! initialisation:
     222      fqfonte_diag(i)  =0.0
     223      fq_fonte_diag(i) =0.0
     224      snow_evap_diag(i)=0.0
     225    ENDDO !DO i=1,knon
     226#ifdef ISOVERIF
     227    ! write(*,*) 'surf_land_bucket 235'
     228    DO i=1,knon 
     229      IF (iso_eau > 0) THEN
     230        CALL iso_verif_egalite(qsol_prec(i),xtsol_prec(iso_eau,i), &
     231    &                              'surf_land_bucket 141')
     232      ENDIF
     233    ENDDO !DO i=1,knon
     234#endif   
     235#endif   
    133236!
    134237!* Calculate snow height, run_off, age of snow
     
    136239    CALL fonte_neige( knon, is_ter, knindex, dtime, &
    137240         tsurf, precip_rain, precip_snow, &
    138          snow, qsol, tsurf_new, evap)
     241         snow, qsol, tsurf_new, evap &
     242#ifdef ISO   
     243     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
     244     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
     245#endif
     246     &   )
     247
     248#ifdef ISO
     249#ifdef ISOVERIF
     250        DO i=1,knon
     251          DO ixt=1,niso
     252            CALL iso_verif_noNaN(xtsol_prec(ixt,i),'surf_land_burcket 237')
     253          ENDDO
     254        ENDDO
     255#endif
     256#ifdef ISOVERIF
     257        !write(*,*) 'surf_land_bucket 235'
     258        DO i=1,knon
     259          IF (iso_eau > 0) THEN
     260            CALL iso_verif_egalite_choix(qsol_prec(i), &
     261     &                                   xtsol_prec(iso_eau,i),'surf_land_bucket 628', &
     262     &                                   errmax,errmaxrel)
     263            CALL iso_verif_egalite_choix(precip_snow(i), &
     264     &                                   xtprecip_snow(iso_eau,i),'surf_land_bucket 227', &
     265     &                                   errmax,errmaxrel)
     266             ! attention, dans fonte_neige, on modifie snow sans modifier
     267             ! xtsnow
     268             ! c'est fait plus tard dans gestion_neige
     269!            write(*,*) 'surf_land_bucket 287: i=',i
     270!            write(*,*) 'snow(i)=',snow(i)
     271            CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
     272     &                                   snow_prec(i),'surf_land_bucket 245', &
     273     &                                   errmax,errmaxrel)
     274          ENDIF 
     275          IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
     276              IF (qsol_prec(i) > ridicule_qsol) THEN
     277                CALL iso_verif_aberrant_o17(xtsol_prec(iso_O17,i)/qsol_prec(i) &
     278     &                                     ,xtsol_prec(iso_O18,i)/qsol_prec(i) &
     279     &                                     ,'surf_land_bucket 642')
     280              ENDIF !IF ((qsol_prec(i) > ridicule_qsol) &
     281          ENDIF !IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
     282        ENDDO  !DO i=1,knon
     283        !write(*,*) 'surf_land_mod 291'
     284        !write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
     285#endif         
     286        CALL calcul_iso_surf_ter_vectall(klon,knon, &
     287     &           evap,snow_evap_diag,snow, &
     288     &           fq_fonte_diag,fqfonte_diag,dtime,precip_rain,xtprecip_rain, &
     289     &           precip_snow,xtprecip_snow, snow_prec,xtsnow_prec, &
     290     &           tsurf_new,xtspechum,pref,spechum,t_coup,u1_lay,v1_lay,p1lay, &
     291     &           qsol,xtsol,qsol_prec,xtsol_prec, &
     292     &           max_eau_sol_diag, &
     293     &           xtevap,xtsnow,h1,runoff_diag,xtrunoff_diag,fqcalving_diag, &
     294     &           knindex,is_ter,run_off_lic_diag,coeff_rel_diag,Rland_ice &
     295     &   )
     296!#ifdef ISOVERIF
     297!        write(*,*) 'surf_land_bucket 303'
     298!#endif
     299#endif
     300
    139301!
    140302!* Calculate the age of snow
Note: See TracChangeset for help on using the changeset viewer.