Changeset 5828


Ignore:
Timestamp:
Sep 23, 2025, 4:32:02 PM (2 months ago)
Author:
rkazeroni
Message:

For GPU porting of call_cloud_optics_prop routine:

  • Add "horizontal" comment to specify possible names of horizontal variables
  • Put routine into module (speeds up source-to-source transformation)
  • Move declaration of variable with SAVE attribute outside of the compute routine to the module
  • Record event with a 2D "first" array instead of a scalar to enable GPU porting
  • Perform reduction on this "first" array and print (once) outside of the compute routine since this cannot be done on GPU in the current form
Location:
LMDZ6/trunk/libf
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/icefrac_lsc_mod.f90

    r5268 r5828  
    2222  ! t_glace_max: if T > Tmax, the cloud is only made of liquid water
    2323  ! exposant_glace: controls the sharpness of the transition
    24   INTEGER :: np
     24  INTEGER, INTENT(IN) :: np
    2525  REAL, DIMENSION(np), INTENT(IN) :: temp ! temperature
    2626  REAL, DIMENSION(np), INTENT(IN) :: sig

  • LMDZ6/trunk/libf/phylmd/lmdz_call_cloud_optics_prop.f90

    r5268 r5828  
    11! $Id$
     2!$gpum horizontal klon np
    23MODULE lmdz_call_cloud_optics_prop
     4  PRIVATE
     5
     6  PUBLIC call_cloud_optics_prop, call_cloud_optics_prop_post
    37
    48CONTAINS
     9
     10  SUBROUTINE call_cloud_optics_prop_post(ok_newmicro)
     11    USE lmdz_cloud_optics_prop, ONLY : cloud_optics_prop_post
     12    IMPLICIT NONE
     13    LOGICAL, INTENT(IN) :: ok_newmicro
     14
     15    IF (ok_newmicro) THEN
     16      CALL cloud_optics_prop_post()
     17    ENDIF
     18
     19  END SUBROUTINE call_cloud_optics_prop_post
    520
    621  SUBROUTINE call_cloud_optics_prop(klon, klev, ok_newmicro,&
    … …  
    2540  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14) 
    2641  USE lmdz_lscp_tools, only: icefrac_lscp
     42  USE nuage_mod, ONLY: nuage
    2743
    2844  IMPLICIT NONE
    … …  
    94110  INTEGER :: k
    95111  REAL :: dzfice(klon, klev)
     112  REAL :: pp_ratio(klon)
    96113
    97114  IF (iflag_t_glace .EQ. 0) THEN
    … …  
    103120   &         icefrac_optics(:,k),dzfice(:,k))
    104121        ELSE
    105           CALL icefrac_lsc(klon,temp(:,k),pplay(1:klon,k)/paprs(1:klon,1),icefrac_optics(:,k))
     122          pp_ratio(1:klon) = pplay(1:klon,k)/paprs(1:klon,1)
     123          CALL icefrac_lsc(klon,temp(:,k),pp_ratio(:),icefrac_optics(:,k))
    106124        ENDIF
    107125     ENDDO
    … …  
    110128
    111129
    112   IF (ok_newmicro) THEN       
     130  IF (ok_newmicro) THEN
    113131    CALL cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pclc, &
    114132    pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, &

  • LMDZ6/trunk/libf/phylmd/lmdz_cloud_optics_prop.f90

    r5646 r5828  
    11! $Id$
    22MODULE lmdz_cloud_optics_prop
     3  PRIVATE
     4
     5  LOGICAL, SAVE :: first_first = .TRUE.
     6  !$OMP THREADPRIVATE(first_first)
     7
     8  PUBLIC cloud_optics_prop, cloud_optics_prop_post
    39
    410CONTAINS
     11
     12SUBROUTINE cloud_optics_prop_post()
     13  USE lmdz_cloud_optics_prop_ini, ONLY: novlp
     14  USE lmdz_cloud_optics_prop_ini, ONLY: first
     15  IMPLICIT NONE
     16
     17  IF (first_first) THEN
     18    IF (ANY(first)) THEN
     19      IF (novlp==1) THEN
     20        WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM_ &
     21                &                                             &
     22                &                                          RANDOM'
     23        first_first = .FALSE.
     24      ELSEIF (novlp==2) THEN
     25        WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM'
     26        first_first = .FALSE.
     27      ELSEIF (novlp==3) THEN
     28        WRITE (*, *) 'Hypothese de recouvrement: RANDOM'
     29        first_first = .FALSE.
     30      ENDIF
     31    ENDIF
     32  ENDIF
     33
     34END SUBROUTINE cloud_optics_prop_post
    535
    636SUBROUTINE cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pclc, &
    … …  
    2959  USE lmdz_cloud_optics_prop_ini , ONLY : rei_coef, rei_min_temp
    3060  USE lmdz_cloud_optics_prop_ini , ONLY : zepsec, novlp, iflag_ice_thermo, ok_new_lscp
     61  USE lmdz_cloud_optics_prop_ini , ONLY : first
    3162 
    3263
    … …  
    115146  ! Local variables
    116147  !----------------
    117 
    118   LOGICAL, SAVE :: first = .TRUE.
    119   !$OMP THREADPRIVATE(first)
    120148  INTEGER flag_max
    121149
    … …  
    652680
    653681          IF (novlp.EQ.2) THEN
    654             IF (first) THEN
    655               WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM'
    656               first = .FALSE.
     682            IF (first_first) THEN
     683              first(i,k) = .TRUE.
    657684            ENDIF
    658685            flag_max = -1.
    … …  
    661688
    662689          IF (novlp.EQ.3) THEN
    663             IF (first) THEN
    664               WRITE (*, *) 'Hypothese de recouvrement: RANDOM'
    665               first = .FALSE.
     690            IF (first_first) THEN
     691              first(i,k) = .TRUE.
    666692            ENDIF
    667693            flag_max = 1.
    … …  
    670696
    671697          IF (novlp.EQ.1) THEN
    672             IF (first) THEN
    673               WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM_ &
    674                 &                                             &
    675                 &                                          RANDOM'
    676               first = .FALSE.
     698            IF (first_first) THEN
     699              first(i,k) = .TRUE.
    677700            ENDIF
    678701            flag_max = 1.
    … …  
    767790  ENDIF !ok_cdnc
    768791
    769   first=.false. !to be sure
    770 
    771792  RETURN
    772793

  • LMDZ6/trunk/libf/phylmd/lmdz_cloud_optics_prop_ini.f90

    r5646 r5828  
    3333  REAL, PARAMETER :: k_ice0=0.005 ! units=m2/g
    3434  REAL, PARAMETER :: df=1.66 ! diffusivity factor
     35  LOGICAL, SAVE, ALLOCATABLE :: first(:,:)  ! Test, if the cloud optical depth exceeds the necessary threshold
     36!$OMP THREADPRIVATE(first)
    3537!$OMP THREADPRIVATE(prt_level, lunout, flag_aerosol, iflag_t_glace)
    3638!$OMP THREADPRIVATE(iflag_rei, novlp, iflag_ice_thermo) 
    … …  
    4547CONTAINS
    4648
    47   SUBROUTINE cloud_optics_prop_ini(klon, prt_level_in, lunout_in, flag_aerosol_in, &
     49  SUBROUTINE cloud_optics_prop_ini(klon, klev, prt_level_in, lunout_in, flag_aerosol_in, &
    4850       & ok_cdnc_in, bl95_b0_in, &
    4951       & bl95_b1_in, latitude_deg_in, rpi_in, rg_in, rd_in, zepsec_in, novlp_in, &
    … …  
    5355
    5456    IMPLICIT NONE
    55     INTEGER, INTENT(IN) :: klon
     57    INTEGER, INTENT(IN) :: klon, klev
    5658    INTEGER, INTENT(IN) :: prt_level_in, lunout_in
    5759    INTEGER, INTENT(IN) :: flag_aerosol_in
    … …  
    6466
    6567    ALLOCATE(latitude_deg(klon))
     68    ALLOCATE(first(klon, klev))
     69    first(:,:) = .FALSE.
    6670
    6771    prt_level = prt_level_in

  • LMDZ6/trunk/libf/phylmd/nuage.f90

    r5305 r5828  
    11! $Id$
     2MODULE nuage_mod
     3  PRIVATE
     4
     5  PUBLIC nuage, diagcld1, diagcld2
     6
     7  CONTAINS
    28
    39SUBROUTINE nuage(paprs, pplay, t, pqlwp,picefra, pclc, pcltau, pclemi, pch, pcl, pcm, &
    … …  
    95101  REAL cldtaupi(klon, klev) ! pre-industrial cloud opt thickness for diag
    96102  REAl dzfice(klon)
     103  REAL :: pp_ratio(klon)
    97104  ! jq-end
    98105
    … …  
    115122            CALL icefrac_lscp(klon,t(:,k),iflag_ice_thermo,distcltop(:,k),temp_cltop(:,k),zfice(:),dzfice(:))
    116123        ELSE
    117             CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:))
     124            pp_ratio(1:klon) = pplay(1:klon,k)/paprs(1:klon,1)
     125            CALL icefrac_lsc(klon,t(:,k),pp_ratio(:),zfice(:))
    118126
    119127        ENDIF
    … …  
    257265  RETURN
    258266END SUBROUTINE nuage
     267
    259268SUBROUTINE diagcld1(paprs, pplay, rain, snow, kbot, ktop, diafra, dialiq)
    260269  USE dimphy
    … …  
    340349  RETURN
    341350END SUBROUTINE diagcld1
     351
    342352SUBROUTINE diagcld2(paprs, pplay, t, q, diafra, dialiq)
    343353  USE dimphy
    … …  
    431441  RETURN
    432442END SUBROUTINE diagcld2
     443
     444END MODULE nuage_mod

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r5825 r5828  
    5353    USE netcdf95, only: nf95_close
    5454    USE netcdf, only: nf90_fill_real     ! IM for NMC files
     55    USE nuage_mod, ONLY: nuage, diagcld1, diagcld2
    5556    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
    5657    USE orografi_mod, ONLY: drag_noro, lift_noro, sugwd
    … …  
    8586    use wxios_mod, ONLY: g_ctx, wxios_set_context
    8687    USE lmdz_lscp_main, ONLY : lscp
    87     USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
     88    USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop, call_cloud_optics_prop_post
    8889    USE lmdz_lscp_old, ONLY : fisrtilp, fisrtilp_first
    8990    USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim
    … …  
    857858    EXTERNAL conema3  ! convect4.3
    858859    EXTERNAL hgardfou  ! verifier les temperatures
    859     EXTERNAL nuage     ! calculer les proprietes radiatives
     860    ! EXTERNAL nuage     ! calculer les proprietes radiatives
    860861    !C      EXTERNAL o3cm      ! initialiser l'ozone
    861862    EXTERNAL orbite    ! calculer l'orbite terrestre
    … …  
    18941895          ENDIF
    18951896       ENDIF
    1896        CALL cloud_optics_prop_ini(klon, prt_level, lunout, flag_aerosol, &
     1897       CALL cloud_optics_prop_ini(klon, klev, prt_level, lunout, flag_aerosol, &
    18971898                                  & ok_cdnc, bl95_b0, &
    18981899                                  & bl95_b1, latitude_deg, rpi, rg, rd, &
    … …  
    45414542               reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
    45424543               zfice, dNovrN, ptconv, rnebcon, clwcon)
     4544       CALL call_cloud_optics_prop_post(ok_newmicro)
    45434545
    45444546       !

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

    r5827 r5828  
    5252    USE netcdf95, only: nf95_close
    5353    USE netcdf, only: nf90_fill_real     ! IM for NMC files
     54    USE nuage_mod, ONLY: nuage, diagcld1, diagcld2
    5455    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
    5556    USE orografi_mod, ONLY: drag_noro, lift_noro, sugwd
    … …  
    930931    EXTERNAL conema3  ! convect4.3
    931932    EXTERNAL hgardfou  ! verifier les temperatures
    932     EXTERNAL nuage     ! calculer les proprietes radiatives
     933    ! EXTERNAL nuage     ! calculer les proprietes radiatives
    933934    !C      EXTERNAL o3cm      ! initialiser l'ozone
    934935    EXTERNAL orbite    ! calculer l'orbite terrestre
    … …  
    20272028          ENDIF
    20282029       ENDIF   
    2029        CALL cloud_optics_prop_ini(klon, prt_level, lunout, flag_aerosol, &
     2030       CALL cloud_optics_prop_ini(klon, klev, prt_level, lunout, flag_aerosol, &
    20302031                                  & ok_cdnc, bl95_b0, &
    20312032                                  & bl95_b1, latitude_deg, rpi, rg, rd, &
Note: See TracChangeset for help on using the changeset viewer.