Ignore:
Timestamp:
Jul 5, 2024, 4:38:48 PM (3 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/fonte_neige_mod.F90

    r4523 r5022  
    3636  REAL, ALLOCATABLE, DIMENSION(:)             :: runofflic_global
    3737  !$OMP THREADPRIVATE(runofflic_global)
     38#ifdef ISO
     39  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrun_off_ter
     40  !$OMP THREADPRIVATE(xtrun_off_ter)
     41  REAL, ALLOCATABLE, DIMENSION(:,:)           :: xtrun_off_lic
     42  !$OMP THREADPRIVATE(xtrun_off_lic)
     43  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrun_off_lic_0
     44  !$OMP THREADPRIVATE(xtrun_off_lic_0)
     45  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtfonte_global
     46  !$OMP THREADPRIVATE(fxtfonte_global)
     47  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtcalving_global
     48  !$OMP THREADPRIVATE(fxtcalving_global)
     49  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrunofflic_global
     50  !$OMP THREADPRIVATE(xtrunofflic_global)
     51#endif
    3852
    3953CONTAINS
    … …  
    123137
    124138  END SUBROUTINE fonte_neige_init
     139
     140#ifdef ISO
     141  SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)
     142
     143! This subroutine allocates and initialize variables in the module.
     144! The variable run_off_lic_0 is initialized to the field read from
     145! restart file. The other variables are initialized to zero.
     146
     147    USE infotrac_phy, ONLY: niso
     148#ifdef ISOVERIF
     149    USE isotopes_mod, ONLY: iso_eau,iso_HDO
     150    USE isotopes_verif_mod
     151#endif
     152!
     153!****************************************************************************************
     154! Input argument
     155    REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff
     156
     157! Local variables
     158    INTEGER                           :: error
     159    CHARACTER (len = 80)              :: abort_message
     160    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'
     161    INTEGER                           :: i
     162
     163
     164!****************************************************************************************
     165! Allocate run-off at landice and initilize with field read from restart
     166!
     167!****************************************************************************************
     168
     169    ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error)
     170    IF (error /= 0) THEN
     171       abort_message='Pb allocation run_off_lic'
     172       CALL abort_gcm(modname,abort_message,1)
     173    ENDIF   
     174   
     175    xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:)       
     176
     177#ifdef ISOVERIF
     178      IF (iso_eau > 0) THEN   
     179        CALL iso_verif_egalite_vect1D( &
     180     &           xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
     181     &           niso,klon)
     182      ENDIF !IF (iso_eau > 0) THEN
     183#endif       
     184
     185!****************************************************************************************
     186! Allocate other variables and initilize to zero
     187!
     188!****************************************************************************************
     189
     190    ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
     191    IF (error /= 0) THEN
     192       abort_message='Pb allocation xtrun_off_ter'
     193       CALL abort_gcm(modname,abort_message,1)
     194    ENDIF
     195    xtrun_off_ter(:,:) = 0.
     196   
     197    ALLOCATE(xtrun_off_lic(niso,klon), stat = error)
     198    IF (error /= 0) THEN
     199       abort_message='Pb allocation xtrun_off_lic'
     200       CALL abort_gcm(modname,abort_message,1)
     201    ENDIF
     202    xtrun_off_lic(:,:) = 0.
     203
     204    ALLOCATE(fxtfonte_global(niso,klon,nbsrf))
     205    IF (error /= 0) THEN
     206       abort_message='Pb allocation fxtfonte_global'
     207       CALL abort_gcm(modname,abort_message,1)
     208    ENDIF
     209    fxtfonte_global(:,:,:) = 0.0
     210
     211    ALLOCATE(fxtcalving_global(niso,klon,nbsrf))
     212    IF (error /= 0) THEN
     213       abort_message='Pb allocation fxtcalving_global'
     214       CALL abort_gcm(modname,abort_message,1)
     215    ENDIF
     216    fxtcalving_global(:,:,:) = 0.0
     217
     218    ALLOCATE(xtrunofflic_global(niso,klon))
     219    IF (error /= 0) THEN
     220       abort_message='Pb allocation xtrunofflic_global'
     221       CALL abort_gcm(modname,abort_message,1)
     222    ENDIF
     223    xtrunofflic_global(:,:) = 0.0
     224
     225  END SUBROUTINE fonte_neige_init_iso
     226#endif
     227
    125228!
    126229!****************************************************************************************
    … …  
    128231  SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
    129232       tsurf, precip_rain, precip_snow, &
    130        snow, qsol, tsurf_new, evap)
    131 
    132   USE indice_sol_mod
     233       snow, qsol, tsurf_new, evap &
     234#ifdef ISO   
     235     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
     236     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
     237#endif
     238     &   )
     239
     240    USE indice_sol_mod
     241#ifdef ISO
     242    USE infotrac_phy, ONLY: niso
     243    !use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
     244#ifdef ISOVERIF
     245    USE isotopes_verif_mod
     246#endif
     247#endif
    133248       
    134249! Routine de traitement de la fonte de la neige dans le cas du traitement
    … …  
    172287    REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
    173288    REAL, DIMENSION(klon), INTENT(INOUT) :: evap
     289
     290#ifdef ISO   
     291        ! sortie de quelques diagnostiques
     292    REAL, DIMENSION(klon), INTENT(OUT) :: fq_fonte_diag
     293    REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_diag
     294    REAL, DIMENSION(klon), INTENT(OUT) ::  snow_evap_diag
     295    REAL, DIMENSION(klon), INTENT(OUT) ::  fqcalving_diag 
     296    REAL,                  INTENT(OUT) :: max_eau_sol_diag 
     297    REAL, DIMENSION(klon), INTENT(OUT) ::  runoff_diag   
     298    REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag 
     299    REAL,                  INTENT(OUT) :: coeff_rel_diag
     300#endif
    174301
    175302! Local variables
    … …  
    193320
    194321    LOGICAL               :: neige_fond
     322
     323#ifdef ISO
     324        max_eau_sol_diag=max_eau_sol
     325#endif
     326
    195327
    196328!****************************************************************************************
    … …  
    231363   
    232364    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
     365#ifdef ISO
     366    snow_evap_diag(:) = snow_evap(:)
     367    coeff_rel_diag    = coeff_rel
     368#endif
     369
    233370
    234371
    … …  
    254391          bil_eau_s(i) = bil_eau_s(i) + fq_fonte
    255392          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno 
     393#ifdef ISO
     394          fq_fonte_diag(i) = fq_fonte
     395#endif
     396
    256397
    257398!IM cf JLD OK     
    … …  
    273414       snow(i)=MIN(snow(i),snow_max)
    274415    ENDDO
     416#ifdef ISO
     417    DO i = 1, knon
     418       fqcalving_diag(i) = fqcalving(i)
     419       fqfonte_diag(i)   = fqfonte(i)
     420    ENDDO !DO i = 1, knon
     421#endif
     422
    275423
    276424    IF (nisurf == is_ter) THEN
    … …  
    278426          qsol(i) = qsol(i) + bil_eau_s(i)
    279427          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
     428#ifdef ISO
     429          runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
     430#endif
    280431          qsol(i) = MIN(qsol(i), max_eau_sol)
    281432       ENDDO
    … …  
    290441       ENDDO
    291442    ENDIF
     443
     444#ifdef ISO
     445    DO i = 1, klon   
     446      run_off_lic_diag(i) = run_off_lic(i)
     447    ENDDO ! DO i = 1, knon   
     448#endif
    292449   
    293450!****************************************************************************************
    … …  
    312469!****************************************************************************************
    313470!
    314   SUBROUTINE fonte_neige_final(restart_runoff)
     471  SUBROUTINE fonte_neige_final(restart_runoff &
     472#ifdef ISO     
     473     &                        ,xtrestart_runoff &
     474#endif   
     475     &                        )
    315476!
    316477! This subroutine returns run_off_lic_0 for later writing to restart file.
    317478!
     479#ifdef ISO
     480    USE infotrac_phy, ONLY: niso
     481#ifdef ISOVERIF
     482    USE isotopes_mod, ONLY: iso_eau
     483    USE isotopes_verif_mod
     484#endif
     485#endif
     486!
    318487!****************************************************************************************
    319488    REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
     489#ifdef ISO     
     490    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
     491#ifdef ISOVERIF
     492    INTEGER :: i
     493#endif 
     494#endif
     495
     496
    320497
    321498!****************************************************************************************
    322499! Set the output variables
    323500    restart_runoff(:) = run_off_lic_0(:)
     501#ifdef ISO
     502    xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:)
     503#ifdef ISOVERIF
     504    IF (iso_eau > 0) THEN   
     505      DO i=1,klon
     506        IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
     507     &                              ,xtrun_off_lic_0(iso_eau,i) &
     508     &                              ,'fonte_neige 413') &
     509     &      == 1) then
     510          WRITE(*,*) 'i=',i
     511          STOP
     512        ENDIF
     513      ENDDO !DO i=1,klon
     514    ENDIF !IF (iso_eau > 0) then
     515#endif   
     516#endif
     517
     518
    324519
    325520! Deallocation of all varaibles in the module
    … …  
    334529    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
    335530    IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
     531#ifdef ISO
     532    IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0)
     533    IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter)
     534    IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic)
     535    IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global)
     536    IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global)
     537    IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global)
     538#endif
     539
    336540
    337541  END SUBROUTINE fonte_neige_final
    … …  
    340544!
    341545  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
    342        fqfonte_out, ffonte_out, run_off_lic_out)
     546              fqfonte_out, ffonte_out, run_off_lic_out &
     547#ifdef ISO     
     548     &       ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
     549#endif     
     550     &       )
    343551
    344552
    … …  
    349557!****************************************************************************************
    350558
    351   USE indice_sol_mod
     559    USE indice_sol_mod
     560#ifdef ISO
     561    USE infotrac_phy, ONLY: niso
     562#endif
    352563
    353564    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
    … …  
    358569    REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out
    359570
     571#ifdef ISO
     572    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtcalving_out
     573    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtfonte_out
     574    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrun_off_lic_out
     575    INTEGER   :: i,ixt
     576#endif
     577 
    360578    INTEGER   :: nisurf
    361579!****************************************************************************************
    … …  
    364582    fqfonte_out(:)   = 0.0
    365583    fqcalving_out(:) = 0.0
     584#ifdef ISO       
     585    fxtfonte_out(:,:)   = 0.0
     586    fxtcalving_out(:,:) = 0.0
     587#endif
    366588
    367589    DO nisurf = 1, nbsrf
    … …  
    373595    run_off_lic_out(:)=runofflic_global(:)
    374596
     597#ifdef ISO
     598    DO nisurf = 1, nbsrf
     599      DO i=1,klon
     600        DO ixt=1,niso
     601          fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf)
     602          fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf)
     603        ENDDO !DO ixt=1,niso
     604      ENDDO !DO i=1,klon
     605    ENDDO !DO nisurf = 1, nbsrf
     606    xtrun_off_lic_out(:,:) = xtrunofflic_global(:,:)
     607#endif
     608
    375609  END SUBROUTINE fonte_neige_get_vars
    376610!
    377611!****************************************************************************************
    378612!
     613!#ifdef ISO
     614!  subroutine fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
     615!    use infotrac_phy, ONLY: niso
     616!
     617!    ! inputs
     618!    INTEGER, INTENT(IN)                      :: knon
     619!    real, INTENT(IN), DIMENSION(niso,klon)   :: xtrun_off_lic_0_diag
     620!
     621!    xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
     622!
     623!  end subroutine fonte_neige_export_xtrun_off_lic_0
     624!#endif
     625
     626#ifdef ISO
     627  SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
     628     &           xtprecip_snow,xtprecip_rain, &
     629     &           fxtfonte_neige,fxtcalving, &
     630     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag)
     631
     632        ! dans cette routine, on a besoin des variables globales de
     633        ! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod
     634        ! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb
     635        ! de dépendance circulaire.
     636
     637    USE infotrac_phy, ONLY: ntiso,niso
     638    USE isotopes_mod, ONLY: iso_eau   
     639    USE indice_sol_mod   
     640#ifdef ISOVERIF
     641    USE isotopes_verif_mod
     642#endif
     643    IMPLICIT NONE
     644
     645    ! inputs
     646    INTEGER, INTENT(IN)                     :: klon,knon
     647    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
     648    REAL, DIMENSION(niso,klon), INTENT(IN)  :: fxtfonte_neige,fxtcalving
     649    INTEGER, INTENT(IN)                     :: nisurf
     650    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
     651    REAL, DIMENSION(klon), INTENT(IN)       :: run_off_lic_diag 
     652    REAL, INTENT(IN)                        :: coeff_rel_diag 
     653
     654    ! locals
     655    INTEGER :: i,ixt,j
     656       
     657#ifdef ISOVERIF
     658    IF (nisurf == is_lic) THEN
     659      IF (iso_eau > 0) THEN 
     660        DO i = 1, knon
     661           j = knindex(i)
     662           CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), &
     663     &             run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
     664        ENDDO
     665      ENDIF
     666    ENDIF
     667#endif
     668
     669! calcul de run_off_lic
     670
     671    IF (nisurf == is_lic) THEN
     672!         coeff_rel = dtime/(tau_calv * rday)
     673
     674      DO i = 1, knon
     675        j = knindex(i)
     676        DO ixt = 1, niso
     677          xtrun_off_lic(ixt,i)   = (coeff_rel_diag *  fxtcalving(ixt,i)) &
     678     &                            +(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
     679          xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i)
     680          xtrun_off_lic(ixt,i)   = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i)
     681        ENDDO !DO ixt=1,niso
     682#ifdef ISOVERIF
     683          IF (iso_eau > 0) THEN             
     684            IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), &
     685     &                  run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
     686     &                  errmax,errmaxrel) == 1) THEN
     687               WRITE(*,*) 'i,j=',i,j   
     688               WRITE(*,*) 'coeff_rel_diag=',coeff_rel_diag
     689               STOP
     690            ENDIF
     691          ENDIF
     692#endif
     693      ENDDO
     694    ENDIF !IF (nisurf == is_lic) THEN 
     695
     696! Save ffonte, fqfonte and fqcalving in global arrays for each
     697! sub-surface separately
     698    DO i = 1, knon
     699      DO ixt = 1, niso
     700        fxtfonte_global(ixt,knindex(i),nisurf)   = fxtfonte_neige(ixt,i)
     701        fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i)
     702      ENDDO !do ixt=1,niso
     703    ENDDO   
     704
     705    IF (nisurf == is_lic) THEN
     706      DO i = 1, knon   
     707        DO ixt = 1, niso   
     708        xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i)
     709        ENDDO ! DO ixt=1,niso   
     710      ENDDO
     711    ENDIF
     712       
     713  END SUBROUTINE gestion_neige_besoin_varglob_fonte_neige
     714#endif
     715
     716
    379717END MODULE fonte_neige_mod
Note: See TracChangeset for help on using the changeset viewer.